Question

我感到茫然，因为我将这个程序写在不同的工作簿中，复制并粘贴多个对象并通过电子邮件将其发送给100人的列表。我接受了程序的“自动发送电子邮件部分”并运行了一段时间，但似乎通过电子邮件将一半的自动化错误发送到50人的列表。

错误代码是 “运行时错误'-2147417851（80010105）'：自动化错误服务器引发了异常。

以下是代码：

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

  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 NSession = CreateObject("Notes.NotesSession")       'using Lotus Notes Automation Classes (OLE)
Set NDatabase = NSession.GetDatabase("", "")

If Not NDatabase.IsOpen Then NDatabase.OPENMAIL

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

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

Answer 1

我相信我已经解决了这个问题，问题出现在循环开始和循环结束时。我需要在循环开始之前实例化Lotus Objects，并在循环结束后清除它们。愚蠢的错误！

VBA - 自动化错误，服务器抛出异常，Lotus Notes自动化代码

1 个答案: