Question

自从我添加strBody行以及所有内容以来，代码的第一部分都不会创建电子邮件。

我从Ron de Bruin的网站上获得了代码并添加了一些内容以根据我的需要进行调整。

  Sub Send_Row()
    'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
    'Don't forget to copy the function RangetoHTML in the module.
    'Working in Excel 2000-2013
        Dim OutApp As Object
        Dim OutMail As Object
        Dim cell As Range
        Dim rng As Range
        Dim Ash As Worksheet
        Dim StrBody As String

        Set Ash = ActiveSheet
        On Error GoTo cleanup
        Set OutApp = CreateObject("Outlook.Application")

        StrBody = "Hello " & cel.Offset(, -1) & "<br>" & "<br>" & _
                  "We regret to inform you that there was an issue with the January interface file and your elections were not" & "<br>" & _
                  "processed correctly.  In order to rectify this situation, we will issue new logs " & "<br>" & _
                  "you will not experience a big hit to time:" & "<br>" & "<br>" & _
                  "Please Check Proposed Adjustment Schedule below" & "<br>" & _
                  "Please contact ." & "<br>" & "<br>" & _
                  "Again, our sincere apologies for the mishaps with the interface file and any inconvenience this may have caused you." & "<br><br><br>"

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

        For Each cell In Ash.Columns("B").Cells.SpecialCells(xlCellTypeConstants)
            If cell.Value Like "?*@?*.?*" _
               And LCase(cell.Offset(0, 1).Value) = "yes" Then

                'Change the filter range and filter Field if needed
                'It will filter on Column B now (mail addresses)
                Ash.Range("A1:J200").AutoFilter Field:=2, Criteria1:=cell.Value

                With Ash.AutoFilter.Range
                    On Error Resume Next
                    Set rng = .SpecialCells(xlCellTypeVisible)
                    On Error GoTo 0
                End With

                Set OutMail = OutApp.CreateItem(0)

                On Error Resume Next
                With OutMail
                    .To = cel.Offset(0, -1).Value
                    .Subject = "Benefits Deductions"
                    .HTMLBody = StrBody & RangetoHTML(rng)
                    .Display  'Or use .Send
                End With
                On Error GoTo 0

                Set OutMail = Nothing
                Ash.AutoFilterMode = False
            End If
        Next cell

    cleanup:
        Set OutApp = Nothing
        With Application
            .EnableEvents = True
            .ScreenUpdating = True
        End With
    End Sub

Answer 1

在StrBody = ...的第一行，你使用一个名为cel的变量，这个变量似乎是未定义的，这可能是你的程序失败的原因。

在正文中创建包含文本的邮件

1 个答案: