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

此代码或非常类似的代码应该可以工作。