Anhänge bei Emails werden nicht gefunden

[ToBu]

Hallo Franz, du hattest mir seinerzeit bei ähnlicher Frage sehr geholfen! Nun habe ich einen Großteil des Moduls für eine neue Anwendung kopiert, aber leider kommt ein Zeitlauffehler: (2147024894 80070002) bei folgendem Modul:
Private Sub SpeichernEmails_Click()
   Dim db                       As DAO.Database
   Dim rs                       As DAO.Recordset
   Dim reportName               As String
   Dim fileName                 As String
   Dim PDFDateiName             As String
   Dim Firma                    As String
   Dim KurzFirma                As String
   Dim Land                     As String
   Dim Land1                    As String
   Dim Email                    As String
    Dim emailTo As String
    Dim emailSubject As String
    Dim emailText As String
    Dim outApp As Outlook.Application
    Dim outMail As Outlook.MailItem
    Dim outlookStarted As Boolean

Set db = CurrentDb
Set rs = db.OpenRecordset("SELECT KurzFirma, Land, Email FROM abf_Hersteller")
   Do Until rs.EOF
       Firma = rs!KurzFirma
       Land1 = rs!Land
       Email = rs!Email
       PDFDateiName = Land1 & "-" & Firma & ".pdf"
       reportName = "ber_Hersteller_Profile_einzeln"
       DoCmd.OpenReport reportName, acViewPreview, , "[KurzFirma] = '" & Firma & "'"
        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
   
        emailTo = Trim(rs.Fields("Email").Value)
                   
        emailSubject = "Plattform"
       
        emailText = "Sehr geehrte Damen und Herren," & vbCrLf & "in beigefügter Anlage finden Sie Ihr Profil." & vbCrLf & "Für Fragen stehen wir Ihnen gerne zur Verfügung und verbleiben" & vbCrLf & vbCrLf _
        & "mit freundlichen Grüßen" & vbCrLf & vbCrLf & "ToBu" & vbCrLf
 
        Set outMail = outApp.CreateItem(olMailItem)
     outMail.Attachments.Add PDFDateiName
        outMail.To = emailTo
        outMail.Subject = emailSubject
        outMail.Body = emailText
        outMail.Display
        outMail.Save
        DoCmd.Close acReport, reportName, acSaveNo
 rs.MoveNext
   Loop
rs.Close

Was muss noch anders eingestellt werden? Könntest du freundlicherweise wieder helfen?
Danke!
Gruß ToBu

[PhilS]

PDFDateiName = Land1 & "-" & Firma & ".pdf"

Damit eine Datei zuverlässig gefunden werden kann, solltest du den vollständigen Pfad, inkl. Laufwerk und Ordner angeben.

[ToBu]

Hallo PhilS, danke für die rasche Antwort! Da ich den Bericht aus Access in PDF drucke, aber nicht speichere, gibt es ja keinen Pfad und Ordner. Das Speichern will ich mir aus Zeitgründen ja ersparen, es soll ja direkt in Entwurf gespeichert werden.

[PhilS]

Da ich den Bericht aus Access in PDF drucke, aber nicht speichere, gibt es ja keinen Pfad und Ordner.

Das ist ein Problem. Die Attachments.Add-Methode eines Outlook.Mailitem kann aber nur mit einer Datei umgehen. Ohne Datei bekommst du den "Datei nicht gefunden"-Fehler, den du festgestellt hast.

[ToBu]

Danke PhilS, da brauch ich mich ja nicht mehr weiter im Kreis zu drehen! Vielen Dank für die Erlösung!!! Oder gibt es vielleicht doch eine andere Methode aus deinem Erfahrungsschatz, die ich auch nachvollziehen kann?

[PhilS]

Oder gibt es vielleicht doch eine andere Methode aus deinem Erfahrungsschatz, die ich auch nachvollziehen kann?

Mit fällt ad-hoc keine ein, bei der sich der Aufwand lohnen würde.

Du schriebst oben:

Das Speichern will ich mir aus Zeitgründen ja ersparen

Was meinst du damit genau? Die Zeit die es dauert das PDF zu speichern? Wie lange dauert das bei deinem Bericht effektiv? Hast du sehr viele Berichte, die du versenden willst, dass das so relevant wird?

[ToBu]

Momentan sind es 140 PDFs. Das dauert ca. 1 1/2 min. Ist eigentlich auch zu vernachlässigen! Aber danke für deine Anregungen und Hinweise. Habe dann das Speichern versucht. Aber da kommt auch eine Fehlermeldung beim Attachment strFilename = PDFDateiName:

Private Sub SpeichernEmails_Click()
 Dim db                       As DAO.Database
   Dim rs                       As DAO.Recordset
   
   Dim reportName               As String
   Dim fileName                 As String
   Dim strSQL                   As String
   Dim PDFDateiName             As String
   Dim PfadName                 As String
   Dim Pfad                     As String
   Dim Firma                    As String
   Dim KurzFirma                As String
   Dim Land                     As String
   Dim Land1                    As String
   Dim Email                    As String
   Dim strFolder As String, strFilename As String
   
    Dim emailTo As String
    Dim emailSubject As String
    Dim emailText As String
 
    Dim Pfad_Ordner As String
   
    Dim outApp As Outlook.Application
    Dim outMail As Outlook.MailItem
    Dim outlookStarted As Boolean

Set db = CurrentDb

strSQL = "SELECT * FROM abf_Aktueller_Pfad_Ordner"
Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)
      Do Until rs.EOF
      Pfad = rs!PDFPfad & "/"
      rs.MoveNext
      Loop
rs.Close
Set FS = CreateObject("Scripting.FileSystemObject")
Set Folder = FS.GetFolder(Pfad)
    For Each File In Folder.Files
    File.Delete
Next
Set rs = db.OpenRecordset("SELECT KurzFirma, Land, Email FROM abf_Hersteller")
   Do Until rs.EOF
       Firma = rs!KurzFirma
       Land1 = rs!Land
       Email = rs!Email
       PDFDateiName = Land1 & "-" & Firma & ".pdf"
       PfadName = Pfad & PDFDateiName
       reportName = "ber_Hersteller_Profile_einzeln"
       DoCmd.OpenReport reportName, acViewPreview, , "[KurzFirma] = '" & Firma & "'"
       DoCmd.OutputTo acOutputReport, reportName, acFormatPDF, PfadName
       DoCmd.Close acReport, reportName, acSaveNo
 'Stop
  'rs.MoveNext
   'Loop
'rs.Close
'Stop



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
   
   emailTo = Trim(rs.Fields("Email").Value)
                   
        emailSubject = "Plattform"
       
        emailText = "Sehr geehrte Damen und Herren," & vbCrLf & "in beigefügter Anlage finden Sie Ihr Profil." & vbCrLf & "Für Fragen stehen wir Ihnen weiterhin gerne zur Verfügung und verbleiben" & vbCrLf & vbCrLf _
        & "mit freundlichen Grüßen" & vbCrLf & vbCrLf & "ToBu" & vbCrLf
        'emailAttachments:
        Set outMail = outApp.CreateItem(olMailItem)
        strFilename = PDFDateiName
        Do Until strFilename = ""
        outMail.Attachments.Add strFilename
        strFilename = Dir()
        Loop

        outMail.To = emailTo
        outMail.Subject = emailSubject
        outMail.Body = emailText
        'outMail.Display
        outMail.Save
  Stop
  rs.MoveNext
   Loop
rs.Close

[ToBu]

PS: Die Anweisung outMail.Attachments.Add strFilename ist gelb hinterlegt! Der Inhalt von strFilename wird korrekt wiedergegeben! Keine Ahnung, warum es damit nicht läuft! Danke für Ratschläge!

[ebs17]

Code [Auswählen] Erweitern

        strFilename = PDFDateiName
        Do Until strFilename = ""
        outMail.Attachments.Add strFilename
        strFilename = Dir()
        LoopDie Schleife sieht unfertig und damit nichtfunktionabel aus. Hier könntest Du Dir testweise ausgeben lassen, was und wieviel da ausgegeben wird.
Inhaltlich: Wenn oben die PDF in Schleife erzeugt werden, könnte man sich diese gleich merken (Array, kommagetrennter String) und sich daraus bedienen, statt das Filesystem auslesen zu wollen (und das nicht beherrscht).

Code [Auswählen] Erweitern

Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)
      Do Until rs.EOF
      Pfad = rs!PDFPfad & "/"
      rs.MoveNext
      Loop
rs.CloseHier macht eine Schleife wenig Sinn. Die Variable Pfad wird den letzten zugewiesenen Wert behalten, die Vorzuweisungen sind umsonst.

[PhilS]

PS: Die Anweisung outMail.Attachments.Add strFilename ist gelb hinterlegt! Der Inhalt von strFilename wird korrekt wiedergegeben!

Das würde ich nochmal hinterfragen...

Pfad = rs!PDFPfad & "/"

Bei Windows Dateisystemen wird der Backslash als Pfad-Trenner verwendet. Du verwendest an dieser Code-Stelle einen Forward-Slash. - Ich habe meine Zweifel, ob das Access und Outlook so für korrekt halten.

Ich schließe mich @ebs17 an, dass, unabhängig von diesem konkreten Laufzeitfehler, in deinem Code einiges logisch nicht so ganz plausibel erscheint.

[ToBu]

Hallo PhilS, danke für deine Hinweise! Ich habe die alles auf "\" umgestellt und die Prozeduren geteilt!
1. Die PDF-Dateien werden aus den Berichten in einem Ordner korrekt gespeichert.
2. Die PDFs sollen nun aus dem Ordner gelesen werden und in Outlook als Anhang in Entwürfe gespeichert werden.
Die Emailentwürfe werden auch dort abgelegt, aber leider ohne die dazugehörigen PDFs aus dem Ordner. Mir fehlt wieder das Verständnis für die richtige Syntax! Meine Prozedur sieht so aus:

Code [Auswählen] Erweitern

Private Sub EmailsInEntwürfe_Click()

  Dim db                      As DAO.Database
  Dim rs                      As DAO.Recordset
 
  Dim reportName              As String
  Dim fileName                As String
  Dim criteria                As String
  Dim strSQL                  As String
  Dim PDFDateiName            As String
  Dim PfadName                As String
  Dim Pfad                    As String
  Dim Firma                    As String
  Dim KurzFirma                As String
  Dim Land                    As String
  Dim Land1                    As String
  Dim Email                    As String
  Dim strFilename              As String
  Dim emailTo                  As String
  Dim emailSubject            As String
  Dim emailText                As String
  Dim Pfad_Ordner              As String
  Dim outApp As Outlook.Application
  Dim outMail As Outlook.MailItem
  Dim outlookStarted As Boolean

Set db = CurrentDb
strSQL = "SELECT * FROM abf_Aktueller_Pfad_Ordner"
Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)
      Pfad = rs!PDFPfad
rs.Close

Set rs = db.OpenRecordset("SELECT KurzFirma, Land, Email FROM abf_Hersteller")
  Do Until rs.EOF
      Firma = rs!KurzFirma
      Land1 = rs!Land
      Email = rs!Email
      PDFDateiName = Land1 & "-" & Firma & ".pdf"
      PfadName = Pfad & PDFDateiName
        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
 
        emailTo = Trim(rs.Fields("Email").Value)
        emailSubject = ">>>Neu: Plattform <<<"
        emailText = "Sehr geehrte Damen und Herren," & vbCrLf & "in beigefügter Anlage finden Sie Ihr Profil." & vbCrLf & "Für Fragen stehen wir Ihnen gerne zur Verfügung und verbleiben" & vbCrLf _

        Set outMail = outApp.CreateItem(olMailItem)
        strFilename = Dir(PfadName)
        outMail.Attachments.Add strFilename
        strFilename = Dir()
       
        outMail.To = emailTo
        outMail.Subject = emailSubject
        outMail.Body = emailText
        outMail.Display
        outMail.Save
Stop
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
Kannst du mir eine funktionierende VBA-Anweisung geben?
Vielen Dank!

[PhilS]

Code [Auswählen] Erweitern

strSQL = "SELECT * FROM abf_Aktueller_Pfad_Ordner"
      Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)
      Pfad = rs!PDFPfad


Vorher hattest du da noch den (falschen) Forward-Slash angehängt.
Hast du jetzt sichergestellt, dass der Pfad aus der Abfrage am Ende einen Backslash hat? Andernfalls kommt da kein gültiger, vollständiger Pfad zustande, wenn du später den Dateinamen anhängst.

Code [Auswählen] Erweitern

        Set outMail = outApp.CreateItem(olMailItem)
        strFilename = Dir(PfadName)
        outMail.Attachments.Add strFilename
        strFilename = Dir()


Was soll das Dir hier bezwecken?
Egal was die Intention davon war/ist, es sabotiert deinen Code! Der Rückgabewert von Dir(PfadName) ist dann wieder der Dateiname ohne Pfad, wie er vorher in PDFDateiName gespeichert war.
(Vorausgesetzt, PfadName enthielt überhaupt einen gültigen Dateinamen, s.o.)

[ToBu]

Hallo PhilS, danke für deine Geduld und Antwort mit den präzisen Schlussfolgerungen!
Ich habe alle "/" in "\" geändert, auch in meiner Access-Pfad-Tabelle, in der ich den letzten "\" hinzugefügt habe. Daher erscheint dieser nicht mehr in der VBA-Anweisung.
Ich finde es toll, dass du mit deiner Erfahrung direkt den "Finger in die Wunde" legst!
In der Tat kann ich dir nicht erklären, warum ich diese DIR-Funktion überhaupt eingebracht habe! Ich weiß auch nicht, was das überhaupt bedeutet! An anderer Stelle hatte das wohl Sinn gemacht, so dass ich dies mit kopiert habe!
Deswegen habe ich nun beide DIR-Anweisungen gelöscht! Und siehe da, es funktioniert! Für mich erstaunlicherweise, da in der Zeile: PfadName = Pfad & PDFDateiName die Inhalte von Pfad wie auch von PDFDateiName korrekt wiedergegeben werden, aber in PfadName lediglich der Inhalt von Pfad und nicht von Pfad und PDFDateiName.
Das gleiche auch in Zeile: strFilename = PfadName (ohne den Namen der anzuhängenden PDFDateiName Datei).
Kannst du mir das noch erklären, warum es jetzt dennoch funktioniert?
Auf jeden Fall erst einmal vielen Dank für sämtliche Hinweise!!!
Gruß ToBu

[ToBu]

Nachtrag: Wie kann man verhindern, dass nach Ablauf der Prozedur in Outlook alle Emails noch geöffnet sind und geschlossen werden müssen? Gibt es eine Anweisung, mit der Outlook geschlossen wird und damit alle geöffneten Emails?

[PhilS]

Für mich erstaunlicherweise, da in der Zeile: PfadName = Pfad & PDFDateiName die Inhalte von Pfad wie auch von PDFDateiName korrekt wiedergegeben werden, aber in PfadName lediglich der Inhalt von Pfad und nicht von Pfad und PDFDateiName.

Ich denke, da hast du bei der Beobachtung des Verhaltens etwas falsch wahrgenommen. PfadName enthält sowohl den Pfad als auch den eigentlichen Dateinamen, sonst kann das nicht funktionieren.