Hallo Liebe VBA Spezialisten,
ich ersuche höflich um Hilfe!
Ich sitze seit Wochen an einem Problem um Serien-Mails mit Pdf-Anhängen zu versenden. Das versenden der Mails funktioniert einwandfrei ... nur leider werden die Pdf-Anhänge nicht angehängt.
Die Anhänge sind im Pfad D:\HDFBL_Mail\ mit der ,,RechnungsNr.pdf" gespeichert - rs!R_Nr & ".PDF" z.B 4999.pdf
Das Feld ,,R_Nr" als LongInteger ist in der Abfrage enthalten.
Der dazugehörige Code habe ich mir aus einigen Forenbeiträgen zusammengestellt.
eMails funktionieren nur die Anhänge wollen nicht mit.
Wäre dankbar und würde mich sehr freuen wenn ich Hilfe bekomme!
Public Sub SendSerialEmail()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strFolder As String
Dim strFilename As String
Dim emailTo As String
Dim emailSubject As String
Dim emailText As String
Dim emailSender As String
Dim Pfad_Ordner As String
Dim outApp As Outlook.Application
Dim outMail As Outlook.MailItem
Dim outlookStarted As Boolean
On Error Resume Next
Set outApp = GetObject(, "Outlook.Application")
On Error GoTo 0
If outApp Is Nothing Then
Set outApp = CreateObject("Outlook.Application")
outlookStarted = True
End If
Set db = CurrentDb
Set rs = db.OpenRecordset("SELECT Firstname, LastName, Subject, HTML, EmailAddress, R_Nr, Sender_" & _
" FROM ABF_Mail")
Do Until rs.EOF
emailSender = Trim(rs.Fields("Sender_").Value)
emailTo = Trim(rs.Fields("FirstName").Value & " " & rs.Fields("LastName").Value) & _
" <" & rs.Fields("EmailAddress").Value & ">"
emailSubject = Trim(rs.Fields("Subject").Value)
If IsNull(rs.Fields("FirstName").Value) Then
emailSubject = emailSubject & " for " & _
rs.Fields("FirstName").Value & " " & rs.Fields("LastName").Value
End If
emailText = Trim("Hallo " & rs.Fields("FirstName").Value) & "!" & vbCrLf & vbCrLf & _
Trim(rs.Fields("HTML").Value
strFolder = Pfad_Ordner 'D:\HDFBL_Mail\
Set outMail = outApp.CreateItem(olMailItem)
With outMail
outMail.SendUsingAccount = GetAccountByEmail(outApp, rs.Fields("Sender_").Value)
End With
strFilename = Dir(Pfad_Ordner & rs!R_Nr & ".PDF")
Do Until strFilename = ""
outMail.Attachments.Add (Pfad_Ordner & strFilename)
strFilename = Dir()
Loop
outMail.To = emailTo
outMail.Subject = emailSubject
outMail.Body = emailText
outMail.Display
rs.MoveNext
Loop
rs.Close
Set rs = Nothing
Set db = Nothing
If outlookStarted Then
outApp.Quit
End If
Set outMail = Nothing
Set outApp = Nothing
End Sub
SerienMailAnhänge.txt
Zitat von: Re_Do am Februar 26, 2023, 16:52:59strFilename = Dir(Pfad_Ordner & rs!R_Nr & ".PDF")
Do Until strFilename = ""
outMail.Attachments.Add (Pfad_Ordner & strFilename)
strFilename = Dir()
Loop
Das ergibt so für mich nicht so recht Sinn.
Dir(Pfad_Ordner & rs!R_Nr & ".PDF") soll dazu dienen, um zu prüfen, ob die gewünschte Datei auch existiert?
Warum ein Loop? Es kann doch nur eine Datei mit exakt diesem Namen geben.
Das wirkt seltsam, kann aber das gewünschte Ziel erreichen.
Der wichtigste Punkt ist aber: Wo/wann bekommt
Pfad_Ordner den gewünschten Ordner zugewiesen? Das ist für mich in dem gezeigten Code nicht erkennbar.
Hallo Phil,
dachte der Loop ist notwendig weil im dem Pfad ca. bis zu 60 Pdf's mit R_Nr gespeichert sind .
Offensichtlich lag ich daneben.
Zu deiner zweiten Frage glaubte ich das mit diesem Eintrag getan hätte
strFolder = Pfad_Ordner 'D:\HDFBL_Mail\ ?
Wie müsste ich denn ändern?
Der Code läuft durch ohne Fehlermeldung und sendet alle Mails .... nur die Anhänge bleiben liegen.
Zitat von: Re_Do am Februar 27, 2023, 20:30:04Zu deiner zweiten Frage glaubte ich das mit diesem Eintrag getan hätte
strFolder = Pfad_Ordner 'D:\HDFBL_Mail\ ?
Damit weist du den Wert von Pfad_Ordner (bisher nur ein leerer String) der Variable strFolder zu, die aber dann gar nicht mehr verwendet wird.
Das 'D:\HDFBL_Mail\ am Ende ist nur ein Kommentar und hat keine technische Funktion.
Wenn der Pfad nur hardcodiert festgelegt werden soll, kannst du die Deklaration von Pfad_Ordner ändern zu:
Const Pfad_Ordner = "D:\HDFBL_Mail\"
Hallo Phil,
vielen Dank, mit der Zuweisung "Pfad_Ordner" werden die Pdf's angehängt.
In meiner Unkenntnis war ich der Meinung das die Dim Anweisung genau richtig wäre.
Mit dem Loop werden auch Mails gesendet, ohne Anhang, die keine relevante Datei im Pfad finden.
Ohne Loop werden auch alle Mails mit Anhang gesendet und ein Laufzeitfehler wird ausgegeben;
"Die Datei kann nicht gefunden werden. Überprüfen Sie Pfad und Dateinamen."
outMail.Attachments.Add (Pfad_Ordner & strFilename)
Wie könnte dass, eventuell mit einer "If Funktion", eingerichtet werden
- das mit Loop, Mails ohne Anhang nicht gesendet werden
und eventuell
- ohne Loop, der Laufzeitfehler abgefangen wird
und in beiden varianten eine MsgBox ausgibt das Mails .... nicht gesendet wurden!
Wärst Du so freundlich und darf ich dich bitten mir dabei noch mal zu helfen?
Mir ist der gesamte Code zu komplex und ich verschachtle mich dabei.