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