Question

我正在使用下面的宏从Excel发送电子邮件。我已经包含了“Ron De Bruin”处理电子邮件正文的方法（Function RangetoHTML（作为范围））。但是在函数结束时我得到一个运行时错误（'438'）并且它将我带到sub中的下一行（.html = rangeto html（rngtext））。我已经检查了代码中的所有内容，我相信我已经拥有了所有必需的“Dim”等等。任何帮助都将不胜感激。

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

我想你想拥有：

.HTMLBody = RangetoHTML(rngText)

我认为.HTML无效。

填充电子邮件的正文

1 个答案: