Question

我有一个VBA cody，可以从excel表创建Outlook电子邮件正文。 excel表中的值基于下拉值。（个月）。如果下拉列表显示1月，则表格也显示1月。我的问题是，Outlook电子邮件HTML主体在同一个月显示alwasy，它们不会根据我的下拉值更改。

Sub CustomMailMessage()

Dim OApp As Object
Dim OMail As Object
Dim rng As Range
Dim sig As String
Dim inputRange As Range

Set dvcell = Worksheets("Sheet2").Range("S1")
Set inputRange = Evaluate(dvcell.Validation.Formula1)

For Each c In inputRange
    For i = 1 To 2
        dvcell = c.Value
        Set OApp = CreateObject("Outlook.Application")
        Set OMail = OApp.CreateItem(0)

        With OMail
            .To = ThisWorkbook.Worksheets("Sheet1").Cells(i, 1).Value
            .Subject = "This is the subject"
            .HTMLBody = RangetoHTML(rng) ---I think here is the issue
            .Display
        End With
    Next i
Next c

Set OApp = Nothing
Set OMail = Nothing

End Sub

这是RangetoHTML函数，它给出了错误的结果

Function RangetoHTML(rng As Range)

        Dim fso As Object
        Dim ts As Object
        Dim TempFile As String
        Dim TempWB As Workbook


        TempFile = ActiveWorkbook.Path & ".htm"

        'Copy the range and create a new workbook to past the data in
       Set rng = ThisWorkbook.Worksheets("Sheet2").Range("A1:M3")
        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
        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)
        RangetoHTML = ts.ReadAll
        ts.Close
        RangetoHTML = Replace(RangetoHTML, "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

Answer 1

那是因为你的复制范围总是不变的：改变这一行：

Set rng = ThisWorkbook.Worksheets("Sheet2").Range("A1:M3")

到根据你的组合框值的范围。

VBA下拉列表创建Outlook电子邮件HTMLBody

1 个答案: