2016-11-10 141 views
1

我有這個電子郵件自動化程序。我基本上想創建一個錯誤捕獲RecpName。當RecpName傳遞到Lotus Notes並返回一個錯誤(由於拼寫錯誤),我想捕獲到一個錯誤捕獲。VBA - 循環,捕獲錯誤,賦值變量並繼續循環?

我仍然希望循環繼續下去並繼續向下,但告訴用戶哪些名稱無法發送電子郵件。

這裏是我的代碼:

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 

回答

0

也許這個代碼可以幫助您:

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;)

+0

這正是我開始寫錯誤處理程序,我非常感謝!本質上,在錯誤處理程序中,我可以將RecpName粘貼到工作表,並使用Resume Next? – Jaz

+0

我編輯了我的回答@Jaz。看看你是否需要;-) – RCaetano

+0

非常感謝你的幫助!我認爲這是徹底的邏輯,這對我有很大的幫助:) – Jaz