AW: Excel Dateien an mehrere Empfänger versenden
01.03.2018 07:07:24
fcs
Hallo Wolfgang,
in einer For-Next-Schleife kann man die verschiedenen Kombinationen von Dateien und Empfängern festlegen und jeweils eine Mail erstellen/versenden.
Gruß
Franz
Sub Versand()
Dim objOutlook As Object
Dim objMail As Object
Dim arrAttach(1 To 11) As String
Dim sPfad As String
Dim varAttach As Variant, itemAttach As Variant
Dim strTo As String, varMail
Set objOutlook = CreateObject("Outlook.Application")
'Verzeichnis mit den Dateien - "\" am Ende nicht vergessen!
sPfad = "C:\Users\Public\NeuTest\DD12\"
'Namen der 11 Dateien der Arrayvariablen zuweisen
arrAttach(1) = sPfad & "dwf.xlsx"
arrAttach(2) = sPfad & "Datei 2.xlsx"
arrAttach(3) = sPfad & "Datei 3.xlsx"
arrAttach(4) = sPfad & "Datei 4.xlsx"
arrAttach(5) = sPfad & "Datei 5.xlsx"
arrAttach(6) = sPfad & "Datei 6.xlsx"
arrAttach(7) = sPfad & "Datei 7.xlsx"
arrAttach(8) = sPfad & "Datei 8.xlsx"
arrAttach(9) = sPfad & "Datei 9.xlsx"
arrAttach(10) = sPfad & "Datei 10.xlsx"
arrAttach(11) = sPfad & "Datei 11.xlsx"
For varMail = 1 To 5 '5 = Anzahl Varianten von Attachment-Kombinationen
'Für die Mail Empfänger und Attachments festlegen
Select Case varMail
Case 1 'Variante 1
strTo = "Nam1@Test.de"
varAttach = Array(2)
Case 2 'Variante 2
strTo = "VN2.Name2@Test.de;VN4.Name4@Test.de"
varAttach = Array(1, 3)
Case 3 'Variante 3
strTo = "VN3.Name3@Test.de;VN5.Name5@Test.de"
varAttach = Array(4, 5)
Case 4 'Variante 4
strTo = "VN12.Name12@Test.de;VN1.Name1@Test.de"
varAttach = Array(7, 9)
Case 5 'Variante 5 - alle Dateien versenden
strTo = "VN7.Name7@Test.de;VN8.Name8@Test.de"
varAttach = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11)
Case Else
If MsgBox("Für Variante """ & varMail & """ ist im Makro noch kein Case mit " _
& "Empänger und Attachments definiert.", _
vbDefaultButton2 + vbQuestion + vbOKCancel, _
"Makro: Versand") = vbCancel Then
GoTo Beenden
Else
GoTo nextMail
End If
End Select
If strTo "" And IsArray(varAttach) Then
'Mailobject erstellen
Set objMail = objOutlook.CreateItem(0)
With objMail
.To = strTo
.Subject = "Report"
.Body = "MfG Wolfgang"
For Each itemAttach In varAttach
.Attachments.Add arrAttach(itemAttach)
Next itemAttach
' .Display 'zum Testen in Outlook anschauen - ggf manuell versenden
.Send 'Für Produktion direkt versenden
End With
strTo = ""
Erase varAttach
Set objMail = Nothing
Else
If MsgBox("case: " & varMail & vbLf & "Liste der Empfänger ist leer " _
& "oder es wurden keine Attachments festgelegt,", _
vbDefaultButton2 + vbQuestion + vbOKCancel, _
"Makro: Versand") = vbCancel Then
GoTo Beenden
Else
GoTo nextMail
End If
End If
nextMail:
Next varMail
Beenden:
End Sub