Generate email displaying columns A:B as a table in email body ?

[MANNG99]

Hi there

I need some help in creating the body of an email that I'm generating in excel.

The basic idea is that I create an email with HTML body, displaying a table made up of values that are located in cells A1:B5.
I can get the values in column A to appear fine, but if I try to change the str from A1:A5 to A1:B5 I get an error ?

Also I'd like the table to have a border and be nicely spaced out however am having difficulty in achieving this.

My current attempt is as below (am still very new to this VBA stuff so excuse the poor coding) ;o) - any help will be greatly appreciated.
Many thanks
G

 Sub GMtest()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range
    Dim strTo As String
 
    Sheets("Sheet1").Select
    Range("A1").Select
 
strTo = Join$(Application.Transpose(Range("A1:A5").Value), "
")
 
    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")
 
    On Error GoTo cleanup
 
            Set OutMail = OutApp.CreateItem(0)
            On Error Resume Next
            With OutMail
 
            .To = "xxx"
            .Subject = "Test mail " & Date
            .HTMLBody = "This is a test"
[B]
 
 
 
 
[B]         .Attachments.Add ActiveWorkbook.FullName[/B]
 
 
[B]           .Display[/B]
[B]           End With[/B]
[B]           On Error GoTo 0[/B]
[B]           Set OutMail = Nothing[/B]
 
 
 
 
 
 
 
[B]cleanup:[/B]
[B]   Set OutApp = Nothing[/B]
[B]   Application.ScreenUpdating = True[/B]
 
 
[B]End Sub[/B]
[/B]

 

[Leith Ross]

Hello MANNG99,

This macro will let you send a range in the body of the email. It will appear like it does on the worksheet.

'Written: September 22, 2008
'Author:  Leith Ross
'Summary: Send a specfied worksheet range in the body of an Outlook email
'         in HTML format.


Sub EmailRangeInHTML(ByVal Recipient As String, ByVal Subject As String, Optional Range_To_Send As Variant)

  Dim FSO As Object
  Dim HTMLcode As String
  Dim HTMLfile As Object
  Dim MyApp As Boolean
  Dim olApp As Object
  Dim Rng As Range
  Dim TempFile As String
  Dim Wks As Worksheet

  Const ForReading As Long = 1
  Const olMailItem = 0
  Const olFormatHTML = 2
  Const UseDefault As Long = -2
    
     If IsMissing(Range_To_Send) Then
       Set Rng = Selection
     Else
       Select Case TypeName(Range_To_Send)
         Case Is = "Range"
           Set Rng = Range_To_Send
         Case Is = "String"
           Set Rng = Evaluate(Range_To_Send)
         Case Else
           MsgBox "Your Selection is Not a Valid Range."
           GoTo CleanUp
       End Select
     End If
     
     Set Wks = Rng.Parent
     TempFile = Environ("Temp") & "\Email.htm"
     
     'Start Outlook
      Set olApp = CreateObject("Outlook.Application")
      
         'Convert the Message worksheet into HTML
          With ActiveWorkbook.PublishObjects.Add( _
            SourceType:=xlSourceRange, _
            FileName:=TempFile, _
            Sheet:=Wks.Name, _
            Source:=Rng.Address, _
            HtmlType:=xlHtmlStatic)
           .Publish (True)
          End With
       
         'Read the HTML file back as a string
          Set FSO = CreateObject("Scripting.FileSystemObject")
          Set HTMLfile = FSO.GetFile(TempFile).OpenAsTextStream(ForReading, UseDefault)
          HTMLcode = HTMLfile.ReadAll
          HTMLfile.Close
          
         'Clean up the HTML code
          HTMLcode = Replace(HTMLcode, "align=center x:publishsource=", _
                      "align=left x:publishsource=")
                      
         'Compose the email
          Set olEmail = olApp.CreateItem(olMailItem)
            With olEmail
              .To = Recipient
              .Subject = Subject
              .BodyFormat = olFormatHTML
              .HTMLBody = HTMLcode
              .Send
            End With
            
  'Exit Outlook
   olApp.Quit
   
  'Delete the Temp File
   If Dir(TempFile) <> "" Then Kill TempFile
   
  'Delete the Publish Object
   With ActiveWorkbook.PublishObjects
     If .Count <> 0 Then .Item(.Count).Delete
   End With
   
  'Free memory resources
   Set olApp = Nothing
   Set olEmail = Nothing
   Set FSO = Nothing

End Sub

Macro Example
Change the recipient to your email address.

Sub EmailMyself()

  EmailRangeInHTML "MANN99@somewhere.com", "Sending Range in HTML test", Worksheets("Sheet1").Range("A1:E10")
  
End Sub

 

[MANNG99]

Thanks Leith

I'm having some error messages with the code that you've created for me.
I'm running in excel 2003 if this matters ?

It doesn't like the Sub name, if I try and run the macro using F5 it can't find it.
If I rename it to "Email()" it then gives me a compile error over the "GoTo Cleanup"

I can't find CleanUp defined anywhere which is possibly what it's referring to ?

If I define cleanup with this:

cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True

I then get your error message for "Your selection is not a valid range" ?

Any ideas where I'm going wrong ?

thanks again

 

[Leith Ross]

Hello MANNG99,

I must have deleted that accidentially. Here is the code with the "Cleanup" line added. The line is in bold. You can add it into your code or just copy and paste this code.

'Written: September 22, 2008
'Author:  Leith Ross
'Summary: Send a specfied worksheet range in the body of an Outlook email
'         in HTML format.


Sub EmailRangeInHTML(ByVal Recipient As String, ByVal Subject As String, Optional Range_To_Send As Variant)

  Dim FSO As Object
  Dim HTMLcode As String
  Dim HTMLfile As Object
  Dim MyApp As Boolean
  Dim olApp As Object
  Dim Rng As Range
  Dim TempFile As String
  Dim Wks As Worksheet

  Const ForReading As Long = 1
  Const olMailItem = 0
  Const olFormatHTML = 2
  Const UseDefault As Long = -2
    
     If IsMissing(Range_To_Send) Then
       Set Rng = Selection
     Else
       Select Case TypeName(Range_To_Send)
         Case Is = "Range"
           Set Rng = Range_To_Send
         Case Is = "String"
           Set Rng = Evaluate(Range_To_Send)
         Case Else
           MsgBox "Your Selection is Not a Valid Range."
           GoTo CleanUp
       End Select
     End If
     
     Set Wks = Rng.Parent
     TempFile = Environ("Temp") & "\Email.htm"
     
     'Start Outlook
      Set olApp = CreateObject("Outlook.Application")
      
         'Convert the Message worksheet into HTML
          With ActiveWorkbook.PublishObjects.Add( _
            SourceType:=xlSourceRange, _
            FileName:=TempFile, _
            Sheet:=Wks.Name, _
            Source:=Rng.Address, _
            HtmlType:=xlHtmlStatic)
           .Publish (True)
          End With
       
         'Read the HTML file back as a string
          Set FSO = CreateObject("Scripting.FileSystemObject")
          Set HTMLfile = FSO.GetFile(TempFile).OpenAsTextStream(ForReading, UseDefault)
          HTMLcode = HTMLfile.ReadAll
          HTMLfile.Close
          
         'Clean up the HTML code
          HTMLcode = Replace(HTMLcode, "align=center x:publishsource=", _
                      "align=left x:publishsource=")
                      
         'Compose the email
          Set olEmail = olApp.CreateItem(olMailItem)
            With olEmail
              .To = Recipient
              .Subject = Subject
              .BodyFormat = olFormatHTML
              .HTMLBody = HTMLcode
              .Send
            End With
 
Cleanup:
 
  'Exit Outlook
   olApp.Quit
   
  'Delete the Temp File
   If Dir(TempFile) <> "" Then Kill TempFile
   
  'Delete the Publish Object
   With ActiveWorkbook.PublishObjects
     If .Count <> 0 Then .Item(.Count).Delete
   End With
   
  'Free memory resources
   Set olApp = Nothing
   Set olEmail = Nothing
   Set FSO = Nothing

End Sub

 

[MANNG99]

Hi Leith - excel still not liking it ??

It's erroring with "Your selection is not a valid range" and then going to cleanup where there's a run time error '91' of Object Variable or With block variable not set

Any ideas ?

 

[daverunt]

You can have a look at doing it this way also.

http://www.mrexcel.com/forum/showthread.php?t=551464

 

[Leith Ross]

Hello MANNG99,

I revised the code and tested it. It works for me under Excel 2003. If there are any errors, you will be notified what the error is by number and description. This should help us locate any problems you are having.

'Written: September 22, 2008
'Updated: August 18, 2011
'Author:  Leith Ross
'Summary: Send a specfied worksheet range in the body of an Outlook email
'         in HTML format.


Sub EmailRangeInHTML(ByVal Recipient As String, ByVal Subject As String, Optional Range_To_Send As Variant)

  Dim FSO As Object
  Dim HTMLcode As String
  Dim HTMLfile As Object
  Dim MyApp As Boolean
  Dim olApp As Object
  Dim Rng As Range
  Dim TempFile As String
  Dim Wks As Worksheet

  Const ForReading As Long = 1
  Const olMailItem = 0
  Const olFormatHTML = 2
  Const UseDefault As Long = -2
    
     On Error GoTo CleanUp
     
     If IsMissing(Range_To_Send) Then
        Set Rng = Selection
     Else
        Select Case TypeName(Range_To_Send)
          Case Is = "Range"
              Set Rng = Range_To_Send
          Case Is = "String"
              Set Rng = Evaluate(Range_To_Send)
          Case Else
              MsgBox "Your Selection is Not a Valid Range."
              GoTo CleanUp
        End Select
     End If
     
     ' Copy the worksheet to create a new workbook
       Set Wks = Rng.Parent
       Wks.Copy
     
     ' The new workbook will be saved to the user's Temp directoy
       TempFile = Environ("Temp") & "\" & Wks.Name & ".htm"
     
     ' If a file by this exists then delete it
       If Dir(TempFile) <> "" Then Kill TempFile
     
         ' Start Outlook
           Set olApp = CreateObject("Outlook.Application")
      
         ' Convert the Message worksheet into HTML
           With ActiveWorkbook.PublishObjects.Add( _
             SourceType:=xlSourceRange, _
             FileName:=TempFile, _
             Sheet:=Wks.Name, _
             Source:=Rng.Address, _
             HtmlType:=xlHtmlStatic)
            .Publish (True)
           End With
       
         ' Read the HTML file back as a string
           Set FSO = CreateObject("Scripting.FileSystemObject")
           Set HTMLfile = FSO.OpenTextFile(TempFile, ForReading, True, UseDefault)
           
            ' Read in the entire file as a string
              HTMLcode = HTMLfile.ReadAll
             
           HTMLfile.Close
          
          
         ' Re-align the HTML code to the left side of the page
           HTMLcode = Replace(HTMLcode, "align=center x:publishsource=", _
                              "align=left x:publishsource=")
                      
         ' Compose and send the email
           Set olEmail = olApp.CreateItem(olMailItem)
             With olEmail
               .To = Recipient
               .Subject = Subject
               .BodyFormat = olFormatHTML
               .HTMLBody = HTMLcode
               .Send
             End With
            
   ' Exit Outlook
     olApp.Quit
            
CleanUp:
   ' Did an error occur
     If Err <> 0 Then
        MsgBox "Run-time error '" & Err.Number & "':" & vbCrLf & vbCrLf & Err.Description
     End If
   
   ' Close the new workbook and don't save it
     ActiveWorkbook.Close SaveChanges:=False
  
   ' Delete the Temp File
     If Dir(TempFile) <> "" Then Kill TempFile
   
   ' Delete the Publish Object
     With ActiveWorkbook.PublishObjects
       If .Count <> 0 Then .Item(.Count).Delete
     End With
   
   ' Free memory resources
     Set olApp = Nothing
     Set olEmail = Nothing
     Set FSO = Nothing

End Sub