E-Mail einen einzelnen Anhang aus dem Ordner der Dateien jeweils an eine andere Person

Question

Ich habe einen Ordner mit 50 Dateien und ich habe eine Liste von 50 E-Mail-Adressen. Jede Datei wird an eine andere E-Mail-Adresse gesendet. Gibt es eine Möglichkeit, ein Makro zu schreiben, das diese Aufgabe ausführt?

Das Problem mit der Reihe von Code unten ist zweifach: 1) Ich habe 3 Spalten von Daten in einer Excel-Datei: Eine für Betreff, eine für E-Mail-Adresse zu senden, und die dritte für den Dateipfad wo der zu befestigende Anhang gespeichert ist.

Der folgende Code erlaubt keine vordefinierte Menge von Subjektargumenten. Es verwendet auch REIHEN ?? für das Dateipfadfeld anstelle einer Spalte wie für das Senden an? So verwirrend.

Sub Send_Files() 
    Dim OutApp As Object 
    Dim OutMail As Object 
    Dim sh As Worksheet 
    Dim cell As Range 
    Dim FileCell As Range 
    Dim rng As Range 

    With Application 
     .EnableEvents = False 
     .ScreenUpdating = False 
    End With 

    Set sh = Sheets("Sheet1") 

    Set OutApp = CreateObject("Outlook.Application") 

    For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants) 

     'Enter the path/file names in the C:Z column in each row 
     Set rng = sh.Cells(cell.Row, 1).Range("C1:Z1") 

     If cell.Value Like "?*@?*.?*" And _ 
      Application.WorksheetFunction.CountA(rng) > 0 Then 
      Set OutMail = OutApp.CreateItem(0) 

      With OutMail 
       .to = cell.Value 
       .Subject = "Testfile" 
       .Body = "Hi " & cell.Offset(0, -1).Value 

       For Each FileCell In rng.SpecialCells(xlCellTypeConstants) 
        If Trim(FileCell) <> "" Then 
         If Dir(FileCell.Value) <> "" Then 
          .Attachments.Add FileCell.Value 
         End If 
        End If 
       Next FileCell 

       .Send 'Or use .Display 
      End With 

      Set OutMail = Nothing 
     End If 
    Next cell 

    Set OutApp = Nothing 
    With Application 
     .EnableEvents = True 
     .ScreenUpdating = True 
    End With 
End Sub 

Answer 1

Hier ist schnelles Beispiel, col A = Email, Col B = Subject & Col C = Path

Option Explicit 
Sub Example() 
    Dim olApp As Object 
    Dim olMail As Object 
    Dim olRecip As Object 
    Dim olAtmt As Object 
    Dim iRow As Long 
    Dim Recip As String 
    Dim Subject As String 
    Dim Atmt As String 

    iRow = 2 

    Set olApp = CreateObject("Outlook.Application") 

    Do Until IsEmpty(Cells(iRow, 1)) 

     Recip = Cells(iRow, 1).Value 
     Subject = Cells(iRow, 2).Value 
     Atmt = Cells(iRow, 3).Value ' Attachment Path 

     Set olMail = olApp.CreateItem(0) 

     With olMail 
     Set olRecip = .Recipients.Add(Recip) 
     .Subject = Subject 
     .Body = "Hi " 
     .Display 
     Set olAtmt = .Attachments.Add(Atmt) 
     olRecip.Resolve 
     End With 

     iRow = iRow + 1 

    Loop 

    Set olApp = Nothing 
    Exit Sub 

End Sub