adding email addresses to auto email

[Bigjayce]

Hi All,

I have a spreadsheet that I use to automatically pick teams for my
football club, one button picks random teams the other opens a new
Outlook message and pastes the teams into it ready to send.

I use the following to paste into the email:

Private Sub CommandButton2_Click()

'Dimension variables
Dim oOutlookApp As Object, oOutlookMessage As Object
Dim oFSObj As Object, oFSTextStream As Object
Dim rngeSend As Range, strHTMLBody As String, strTempFilePath As
String

'Select the range to be sent
On Error Resume Next
Set rngeSend = ActiveSheet.Range("f22:g32")
If rngeSend Is Nothing Then Exit Sub
'User pressed Cancel
On Error GoTo 0


'Get the temp folder path
Set oFSObj = CreateObject("Scripting.FilesystemObject")
strTempFilePath = oFSObj.GetSpecialFolder(2)
strTempFilePath = strTempFilePath & "\XLRange.htm"


'Create the HTML file
ActiveWorkbook.PublishObjects.Add(4, strTempFilePath, _
rngeSend.Parent.Name,
rngeSend.Address, 0, "", "").Publish True

'Create an instance of Outlook (or use existing instance if it
already exists
Set oOutlookApp = CreateObject("Outlook.Application")

'Create a mail item
Set oOutlookMessage = oOutlookApp.CreateItem(0)

'Open the HTML file using the FilesystemObject into a TextStream
object
Set oFSTextStream = oFSObj.OpenTextFile(strTempFilePath, 1)

'Now set the HTMLBody property of the message to the text contained
in the TextStream object
strHTMLBody = oFSTextStream.ReadAll

strHTMLBody = Replace(strHTMLBody, "align=center", "align=left", ,
, vbTextCompare)

oOutlookMessage.HTMLBody = strHTMLBody

oOutlookMessage.Display

End Sub

What I would like to do now is add the email addresses to the message
and also if possible a subject header including the date of the next
game.

The email addresses are contained in a range on the master sheet but
I'm unsure if it will be possible to do this - anyone got any ideas ?

Jayce

 

[Tom Ogilvy]

See Ron de Bruin's site for examples of how to do this:

http://www.rondebruin.nl/sendmail.htm