VBA：通過IBM Notes發送電子郵件（帶有附件）嗎？

Question

我有一個這樣的工作簿：

Column B                           Column Q
C:\Folder\file1.xls                Recipient1@email.com
C:\Folder\file2.xls                Recipient2@email.com
C:\Folder\file3.xls                Recipient3@email.com

我想向Q列中的每個收件人發送一封電子郵件。我不想向多個收件人發送一封電子郵件，而是希望列表中的每個收件人發送一封電子郵件。

電子郵件主題，正文等每次都相同，但我也想為每封電子郵件附加B列中的每個相應工作簿。

因此，例如，發送給收件人1的電子郵件將包含文件file1.xls，發送給收件人2的電子郵件將包含文件file2.xls，依此類推。

這是我的代碼：

Sub Macro1()
    ActiveWorkbook.Save

    Dim iMsg As Object
    Dim iConf As Object
    Dim strbody As String
    Dim fromAdr As String
    Dim subject As String
    Dim recip As String
    Dim numSend As Integer
    Dim Attachment1 As String

    ' Mail settings
    Set iMsg = CreateObject("CDO.Message")
    Set iConf = CreateObject("CDO.Configuration")
    iConf.Load -1    ' CDO Source Defaults
    Set Flds = iConf.Fields

    ' Mail fields
    fromAdr = """example@example.com"
    recip = Range("Q1").Value
    Debug.Print strbody
    subject = "Orders fondsen"
    strbody = strbody & "Hi," & vbNewLine & vbNewLine & _
              "Please find the document..."

    ' Fields layout
    strbody = strbody & vbNewLine & vbNewLine & "Text"
    Debug.Print strbody
    strbody = strbody & vbNewLine & vbNewLine & "Kind regards,"

    ' Location attachment
    Attachment1 = "file-path"

    ' send mail
    On Error GoTo handleError
    With iMsg
   Set .Configuration = iConf
   .To = recip
   .CC = ""
   .From = fromAdr
   .subject = subject
   .TextBody = strbody
   .AddAttachment Attachment1
   .Send
End With
    numSend = numSend + 1
    GoTo skipError

handleError:
    numErr = numErr + 1
    oFile.WriteLine "*** ERROR *** Email for account" & " not sent. Error: " & Err.Number & " " & Err.Description
skipError:

    On Error GoTo 0

    MsgBox "Total number of emails send: " & numSend & vbNewLine & "Total number of errors: " & numErr, vbOKOnly + vbInformation, "Operation finished"
    GoTo endProgram
cancelProgram:
    MsgBox "No emails have been sent.", vbOKOnly + vbExclamation, "Operation cancelled"

endProgram:
    Application.Interactive = True
    Set iMsg = Nothing
    Set iConf = Nothing
    Set dp = Nothing
End Sub

目前，此代碼將發送一封帶有一個附件的電子郵件。 我是vba的新手，所以不確定如何執行此操作，但是請有人可以告訴我讓我的代碼執行我想要的操作嗎？

附言：我在這條線上也遇到錯誤，並且不確定原因：

 oFile.WriteLine "*** ERROR *** Email for account" & " not sent. Error: " & Err.Number & " " & Err.Description

提前致謝

Answer 1

您將需要添加一個循環，以便您的代碼可以選擇每個收件人並為每個收件人添加附件。

Sub Macro1()
    ActiveWorkbook.Save

    Dim iMsg As Object
    Dim iConf As Object
    Dim strbody As String
    Dim fromAdr As String
    Dim subject As String
    Dim recip As String
    Dim numSend As Integer
    Dim Attachment1 As String

    ' Mail settings
    Set iMsg = CreateObject("CDO.Message")
    Set iConf = CreateObject("CDO.Configuration")
    iConf.Load -1    ' CDO Source Defaults
    Set Flds = iConf.Fields

    ' Add the loop
    Range("Q1").Select
    While ActiveCell.Value <> ""

    ' Mail fields
    recip = ActiveCell.Value
    Debug.Print strbody
    strbody = strbody & "Hi," & vbNewLine & vbNewLine & _
              "Please find the document..."

    ' Fields layout
    strbody = strbody & vbNewLine & vbNewLine & "Text"
    Debug.Print strbody
    strbody = strbody & vbNewLine & vbNewLine & "Kind regards,"

    ' Location attachment
    Attachment1 = Range("B" & ActiveCell.Row).Value

    ' send mail
    On Error GoTo handleError
    With iMsg
   Set .Configuration = iConf
   .To = recip
   .CC = ""
   .From = "example@example.com"
   .subject = "Orders fondsen"
   .Body = strbody
   .AddAttachment Attachment1
   .Send
End With

    ActiveCell.Offset(1,0).Select
    Wend

    numSend = numSend + 1
    GoTo skipError

handleError:
    numErr = numErr + 1
    oFile.WriteLine "*** ERROR *** Email for account" & " not sent. Error: " & Err.Number & " " & Err.Description
skipError:

    On Error GoTo 0

    MsgBox "Total number of emails send: " & numSend & vbNewLine & "Total number of errors: " & numErr, vbOKOnly + vbInformation, "Operation finished"
    GoTo endProgram
cancelProgram:
    MsgBox "No emails have been sent.", vbOKOnly + vbExclamation, "Operation cancelled"

endProgram:
    Application.Interactive = True
    Set iMsg = Nothing
    Set iConf = Nothing
    Set dp = Nothing
End Sub

此代碼或非常類似的代碼應該可以工作。