Question

我有一个宏，可发送带有从excel提取的文本的电子邮件。宏具有两个功能。第一个功能是将excel数据粘贴到电子邮件正文中，第二个功能将我的电子邮件签名粘贴到宏中。参见下面的代码。

Sub SendEmail()

    Dim rng As Range
    Dim OutApp As Object
    Dim OutMail As Object
    On Error Resume Next
    Dim sig As Range

    Sheets("DMR").Select
    Range("$A$3:$T$100").AutoFilter Field:=4, Criteria1:=Sheets("Daily Maturing Repo").Range("G1").Value

    Set rng = Sheets("DMR").Range("A3:I100").SpecialCells(xlCellTypeVisible)
    Set sig = Sheets("Signatures").Range("B1:B8").SpecialCells(xlCellTypeVisible)

    On Error GoTo 0

    If rng Is Nothing Then
        MsgBox "The selection is not a range or the sheet is protected" & _
        vbNewLine & "please correct and try again.", vbOKOnly
        Exit Sub
    End If

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
    On Error Resume Next

    strHtml = "Hello," & "<br>" & "<br>" & "Please confirm the below reverse repo activity for today." & "<br>" '"<html>" & "<body>" & "Hello," & "<br>" & "<br>" & "Please confirm the below activity for today." & "<br>"
    stringHtml = "<br>" & "Thank you," & "<br>"

    With OutMail
        .To = ThisWorkbook.Sheets("Contacts").Range("D2")
        .CC = "xx@xyz.com"
        .Subject = "Reverse Repo Activity - " & ThisWorkbook.Sheets("DMR").Range("G1")
        .HTMLBody = strHtml & RngtoHTML(rng) & stringHtml & SignaturetoHTML(sig)
        .Display
    End With
    On Error GoTo 0
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
    Set OutMail = Nothing
    Set OutApp = Nothing
    ActiveWorkbook.CheckCompatibility = False
    'ActiveWorkbook.Save
    Sheets("DMR").Cells.AutoFilter

End Sub

Function RngtoHTML(rng As Range)

    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook
    Dim rngCl As Range
    TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

    'Copy the range and create a new workbook to paste the data in
    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

     'Publish the sheet to a htm file
    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

     'Read all data from the htm file into RangetoHTML
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RngtoHTML = ts.ReadAll
    ts.Close
    RngtoHTML = Replace(RngtoHTML, "align=center x:publishsource=", _
    "align=left x:publishsource=")

    'Close TempWB
    TempWB.Close SaveChanges:=False

    'Delete the htm file we used in this function
    Kill TempFile

    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing

End Function

Function SignaturetoHTML(sig As Range)

    Dim fso1 As Object
    Dim ts1 As Object
    Dim TempFile1 As String
    Dim TempWB1 As Workbook
    TempFile1 = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

     'Copy the range and create a new workbook to past the data in
    sig.Copy
    Set TempWB1 = Workbooks.Add(1)
    With TempWB1.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

     'Publish the sheet to a htm file
    With TempWB1.PublishObjects.Add( _
        SourceType:=xlSourceRange, _
        Filename:=TempFile1, _
        Sheet:=TempWB1.Sheets(1).Name, _
        Source:=TempWB1.Sheets(1).UsedRange.Address, _
        HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With

    Set fso1 = CreateObject("Scripting.FileSystemObject")
    Set ts1 = fso1.GetFile(TempFile1).OpenAsTextStream(1, -2)
    SignaturetoHTML = ts1.ReadAll
    ts1.Close
    SignaturetoHTML = Replace(SignaturetoHTML, "align=center x:publishsource=", _
    "align=left x:publishsource=")

    TempWB1.Close SaveChanges:=False

    Kill TempFile1

    Set ts1 = Nothing
    Set fso1 = Nothing
    Set TempWB1 = Nothing

End Function

由于某种原因，我的宏只吐出了HTML正文中的“结果”函数之一。如果我删除一个（例如RngHTML），另一个（例如SignatureHTML）则可以，反之亦然，但是由于某些原因，它们不能同时工作。令我感到困惑的是，它们两者显然都可以工作，只是如果可行的话，它们就不会同时工作。有什么建议么？让我知道您是否需要任何澄清。

VBA：无法同时识别我的两个功能

0 个答案: