Question

我正在尝试使用Outlook模板自动发送邮件，对链接到excel文件的文本进行微小更改。但是当我选择HTML格式时，结果不会出现。这是我的代码：我认为问题在于.HTMLbody行，因为代码中的其他所有内容都可以正常工作。有人可以帮忙吗？

Sub Test1()

'Working in Office 2000-2016
    Dim OutApp As Outlook.Application
    Dim OutMail As Outlook.MailItem
    Dim cell As Range

    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItemFromTemplate("C:\Users\600008809\Desktop\Reminder emails\Initial Survey.oft")

    On Error GoTo cleanup
    For Each cell In Columns("G").Cells.SpecialCells(xlCellTypeConstants)
        If cell.Value Like "?*@?*.?*" And _
           LCase(Cells(cell.Row, "H").Value) = "yes" _
           And LCase(Cells(cell.Row, "I").Value) <> "send" Then    
            'Set OutMail = OutApp.CreateItem(0)    
            On Error Resume Next
            With OutMail
                 .To = cell.Value
                 .Subject = "abc!"
                 .BodyFormat = olFormatHTML
                 .HTMLBody = Replace(.HTMLBody, "&lt;&lt; HiringManager &gt;&gt;", Worksheets("Tool").Range(4, 2))                                  
                'You can add files also like this
                '.Attachments.Add ("C:\test.txt")
                Set .SendUsingAccount = OutApp.Session.Accounts.Item("abc@xyz.com")
                .Send
                '.Display 'Or use Display
            End With
            On Error GoTo 0
            Cells(cell.Row, "I").Value = "send"
            Set OutMail = Nothing                
        End If
    Next cell

cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True

End Sub

Answer 1

这条线不好：

.HTMLBody = Replace(.HTMLBody, "<< HiringManager >>", Worksheets("Tool").Range(4, 2)

您必须在此处替换范围值或单元格值，以便使用

.HTMLBody = Replace(.HTMLBody, "<< HiringManager >>", Worksheets("Tool").cells(4, 2).value

通过vba excel发送时替换oft模板中的内容

1 个答案: