Question

我有这个电子邮件自动化程序。我基本上想为RecpName创建一个错误捕获。当RecpName传递到Lotus Notes并返回错误（由于拼写错误）时，我想将其捕获到错误捕获中。

我仍然希望循环继续向下并继续列表，但告诉用户它无法向哪些名称发送电子邮件。

这是我的代码：

Sub Send_HTML_Email()

    Const ENC_IDENTITY_8BIT = 1729

    'Send Lotus Notes email containing links to files on local computer

    Dim NSession As Object      'NotesSession
    Dim NDatabase As Object     'NotesDatabase
    Dim NStream As Object       'NotesStream
    Dim NDoc As Object          'NotesDocument
    Dim NMIMEBody As Object     'NotesMIMEEntity
    Dim SendTo As String
    Dim subject As String
    Dim HTML As String, HTMLbody As String
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim lstrow As Long, j As Long
    Dim RecpName As String, candiName As String
    Dim a As Hyperlink

    Set wb = ThisWorkbook
    Set ws = wb.Worksheets("Detail")

    ' Instantiate the Lotus Notes COM's Objects.

    lstrow = ws.Range("B" & Rows.Count).End(xlUp).Row
    Set NSession = CreateObject("Notes.NotesSession")       'using Lotus Notes Automation Classes (OLE)
    Set NDatabase = NSession.GetDatabase("", "")

    If Not NDatabase.IsOpen Then NDatabase.OPENMAIL

    For j = 3 To lstrow
        RecpName = ws.Cells(j, 2).Text
        candiName = ws.Cells(j, 1).Text

        SendTo = RecpName
        subject = wb.Worksheets("Email Settings").Range("B1").Text
        Debug.Print subject

        Set NStream = NSession.CreateStream

        HTMLbody = "<p>" & "Hi " & ws.Cells(j, 2).Text & "," & "</p>" & _
        vbCrLf & _
        "<p>" & Sheets("Email Settings").Cells(2, 2).Text & vbCrLf & _
        Sheets("Detail").Cells(j, 1).Text & "</p>" & vbCrLf & _
        "<p>" & Sheets("Email Settings").Cells(3, 2).Text & _
        "<br>" & Sheets("Email Settings").Cells(4, 2).Text & _
        "<br>" & Sheets("Email Settings").Cells(5, 2).Text & _
        "<br>" & Sheets("Email Settings").Cells(6, 2).Text & "</p>" & _
        "<p>" & Sheets("Email Settings").Cells(9, 2).Text & _
        "<br>" & Sheets("Email Settings").Cells(10, 2).Text & _
        "<br>" & Sheets("Email Settings").Cells(11, 2).Text & _
        "<br>" & Sheets("Email Settings").Cells(12, 2).Text & _
        "<br>" & Sheets("Email Settings").Cells(13, 2).Text & _
        "<br>" & Sheets("Email Settings").Cells(14, 2).Text & _
        "<br>" & Sheets("Email Settings").Cells(15, 2).Text & "</p>"

        HTML = "<html>" & vbLf & _
               "<head>" & vbLf & _
               "<meta http-equiv=""Content-Type"" content=""text/html; charset=UTF-8""/>" & vbLf & _
               "</head>" & vbLf & _
               "<body>" & vbLf & _
               HTMLbody & _
               "</body>" & vbLf & _
               "</html>"

        NSession.ConvertMime = False     'Don't convert MIME to rich text

        Set NDoc = NDatabase.CreateDocument()

        With NDoc
            .Form = "Memo"
            .subject = subject
            .SendTo = Split(SendTo, ",")

            Set NMIMEBody = .CreateMIMEEntity
            NStream.WriteText HTML
            NMIMEBody.SetContentFromText NStream, "text/html; charset=UTF-8", ENC_IDENTITY_8BIT

            .Send False
            .Save True, False, False
        End With

        NSession.ConvertMime = True      'Restore conversion

    Next j
    Set NDoc = Nothing
    Set NSession = Nothing
    MsgBox "The e-mail has successfully been created and distributed", vbInformation

End Sub

Answer 1

也许这段代码可以帮到你：

Sub Send_HTML_Email()

    Dim cnt_err As Integer: cnt_err = 1
    On Error GoTo ErrorHandler

    Const ENC_IDENTITY_8BIT = 1729

    ' Insert the rest of the code here

    MsgBox "The e-mail has successfully been created and distributed", vbInformation

    Exit Sub

ErrorHandler:
    ' Insert code to handle the error, e.g.
    wb.Worksheets("SheetToSaveMailsNotSent").Range("A" & cnt) = RecpName
    cnt = cnt + 1        
    ' The next instruction will continue the subroutine execution
    Resume Next

End Sub

如需更多帮助，请访问此link。

HTH;）

VBA - 循环，捕获错误，分配变量并继续循环？

1 个答案: