VBA Serienmail mit individuellem Anhang
08.09.2022 00:25:43
Steffen
Ich habe eine Excel Tabelle gebaut und Mailadressen und Rechnungsnummern eingetragen sowie meine Textbausteine.
Jetzt soll an jede Adresse die passende PDF sowie der entsprechende Betreff gesendet werden.
Ich sage also VBA es soll eine Mail erstellen und den Anhang mit Pfad:
C:\Users\zocke\Desktop\Neuer Ordner (4)"Rechnungsnummer".pdf anhängen.
Wenn ich hier in VBA direkt 55000 eingebe funktioniert das ( es wird die PDF mit Rechnungsnummer 55000 angehängt), wenn ich die Zelle in der die Rechnungsnummer gespeichert wurde über Range(A1).Value bzw. Cells (1,1).Value anspreche klappts auch.
Nur wenn ich versuche die Zeile variabel zu setzen z.B (Ai) oder Cells(i,1) einsetze gehts nicht mehr.
Die Zeile müsste etwa so aussehen:
.attachments.Add "C:\Users\zocke\Desktop\Neuer Ordner (4)" + "" + Cells(i,1).Value + pdf
Bis auf diesen Punkt funktioniert der Code perfekt und es gehen nacheinander die Mails an die entsprechenden Adressen und auch die Betreffzeilen passen.
Ich habe versucht die Pfade direkt aus den Zellen zu lesen oder via Hyperlink anzusteuern. Das hat nicht geklappt worauf ich mir die den Datei-Pfad aus Einzelbausteinen erzeugt habe Pfad + Rechnungsnummer +.pdf .
Ich denke das sollte der richtige Weg sein nur fehlt mir die passende Syntax damit bei jedem Schleifenumlauf die nächste Rechnungsnummer in den Pfad gebaut wird.
Also Rechnung = Range("I2").Value zu Rechnung = Range("I(variabel)").Value
Hier der komplette Code:
Sub Excel_Serienmail_via_Outlook_Senden()
Dim OutApp As Object, Mail As Object
Dim i As Integer
Dim Nachricht
Dim Rechnung As String
Pfad = "C:\Users\zocke\Desktop\Neuer Ordner (4)"
pdf = ".pdf"
Rechnung = Range("I2").Value
For i = 1 To 2 'Anzahl der Mails
'Variablen müssen bei jeder Schleife neu initalisiert werden
Set OutApp = CreateObject("Outlook.Application")
Set Nachricht = OutApp.CreateItem(0)
With Nachricht
.To = Cells(i, 1) 'Adresse
.Subject = Cells(i, 5) 'Betreffzeile
.attachments.Add "C:\Users\zocke\Desktop\Neuer Ordner (4)" + "\" + Rechnung + pdf
.Body = Cells(i, 3) & Chr$(10) & Chr$(10) & Cells(i, 6) & Space(1) & _
Cells(i, 5) & Chr$(10) & Chr$(10) & Cells(i, 16) 'Sendetext
'Hier wird die Mail gleich in den Postausgang gelegt
'und die Sicherheitsabfrage muss jedesmall bestätigt werden
'.Send
'Hier wird die Mail "angezeigt"
'aber gleich versendet,... OHNE Sicherheitsabrage
.Display
SendKeys "%s", True
End With
'Variablen zurücksetzen sonst geht es nicht
Set OutApp = Nothing 'CreateObject("Outlook.Application")
Set Nachricht = Nothing 'OutApp.CreateItem(0)
Application.Wait (Now + TimeValue("0:00:01"))
Next i
End Sub