VBA: E-Mail (mit Anhang) über IBM Notizen senden?

Question

Ich habe eine Arbeitsmappe wie so:

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 

Ich möchte eine E-Mail an jeden meiner Empfänger in Spalte Q. senden will ich nicht eine E-Mail an mehrere Empfänger senden, anstatt ich will 1 senden E-Mail pro Empfänger in der Liste.

Der E-Mail Betreff, Text usw. wird jedes Mal gleich sein, aber ich möchte auch jede entsprechende Arbeitsmappe aus Spalte B für jede E-Mail anhängen.

So wird zum Beispiel die an Empfänger 1 gesendete E-Mail die Datei file1.xls enthalten und die an Empfänger 2 gesendete E-Mail enthält die Datei file2.xls und so weiter.

Hier ist mein Code:

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 

Im Moment dieser Code eine E-Mail mit einem Anhang senden wird. Ich bin ganz neu bei VBA, bin mir also nicht sicher, wie ich das machen soll, aber bitte kann mir jemand zeigen, dass ich meinen Code bekomme, um zu tun, was ich will?

P.S. Ich bin auch einen Fehler auf der Linie bekommen und bin nicht sicher, warum:

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

Vielen Dank im Voraus

Answer 1

Sie müssen eine Schleife hinzufügen, so dass der Code jeden des Empfängers auswählen und einen Anhang hinzufügen für jeden.

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 

Dieser Code oder etwas sehr ähnliches sollte funktionieren.