简体   繁体   中英

VBA Drop Down creates Outlook emails HTMLBody

I have a VBA cody which creates Outlook email body from an excel table. The values in the excel table based on Drop down value. (months). If drop down shows January, the table shows January too. My issue is that the Outlook emails HTML body shows alwasy the same months, they are not changing based on my drop down value.

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

Here is the RangetoHTML function which gives me wrong result

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

thats because your copying range is always constant: change this line :

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

to the range according to your combo-box value.

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM