Question

I’m using the Macro below to send E-mails from Excel. I have included “Ron De Bruin’s” approach for handling the body of the e-mail (Function RangetoHTML(rng As Range)). However at the end of the function I’m getting a run time error (‘438’) and it’s takes me to the follwoing line in the sub (.html = rangeto html(rngtext)). I have checked everything in the code and I believe I have all the required “Dim’s” etc. Any help would be greatly appreciated.

Sub Email_set_up()
Dim valdate As String
Dim oOApp As New Outlook.Application
Dim oOmail As Outlook.MailItem
Dim rng As Range, rngText As Range
Dim strbody As String
Dim SigString As String
Dim Signature As String
Set oOApp = CreateObject("Outlook.Application")
Set oOmail = oOApp.CreateItem(olMailItem)
valdate = Format(Sheets("E-Mail").Cells(4, 2), "mm/dd/yyyy")

SigString = Environ("appdata") & _
 "\Microsoft\Signatures\CK_Sign.txt"

If Dir(SigString) <> "" Then
    Signature = GetBoiler(SigString)
Else
    Signature = ""
End If

Set rngText = Sheets("E-Mail").Range("A18:A29")

Sheets("E-Mail").Activate
    With oOmail
        For Each c In Range(Sheets("E-Mail").Range("B6"), Sheets("E-Mail").Range("B9"))
            .Recipients.Add c
        Next
        .CC = Sheets("E-Mail").Range("B11")
        .Subject = Sheets("E-Mail").Range("B16") & valdate
        .HTML = RangetoHTML(rngText)
        .Display
    End With
End Sub

Function GetBoiler(ByVal sFile As String) As String
Dim fso As Object
Dim ts As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
GetBoiler = ts.ReadAll
ts.Close
End Function

Function RangetoHTML(rng As Range)
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook

TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

rng.Copy
Set TempWB = Workbooks.Add(1)
With TempWB.Sheets(1)
    .Cells(1).PasteSpecial Paste:=8
    .Cells(1).PasteSpecial xlPasteValues, , False, False
    .Cells(1).PasteSpecial xlPasteFormats, , False, False
    .Cells(1).Select
    Application.CutCopyMode = False
    On Error Resume Next
    .DrawingObjects.Visible = True
    .DrawingObjects.Delete
    On Error GoTo 0
End With

With TempWB.PublishObjects.Add( _
     SourceType:=xlSourceRange, _
     Filename:=TempFile, _
     Sheet:=TempWB.Sheets(1).Name, _
     Source:=TempWB.Sheets(1).UsedRange.Address, _
     HtmlType:=xlHtmlStatic)
    .Publish (True)
End With

Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.ReadAll
ts.Close
RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                      "align=left x:publishsource=")

TempWB.Close savechanges:=False

Kill TempFile

Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing
End Function

Answer 1

I think you want to have:

.HTMLBody = RangetoHTML(rngText)

I don’t believe .HTML is valid.