Anhänge bei Emails werden nicht gefunden

[PhilS]

Wie kann man verhindern, dass nach Ablauf der Prozedur in Outlook alle Emails noch geöffnet sind und geschlossen werden müssen?

Du könntest am Ende der Schleife, vor dem Loop, das Mailitem schließen:

Code [Auswählen] Erweitern

outMail.Close(olSave)
Outlook kannst du natürlich auch komplett schließen:

Code [Auswählen] Erweitern

outApp.QuitAber viele Benutzer werden das absolut nicht mögen, weil sie Outlook während der Arbeit gern ständig geöffnet haben.

[ToBu]

Hallo PhilS,
zu deiner Aussage "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." kann ich nur sagen, dass in PfadName der Inhalt von PDFName nicht mit rüber kommt! Wenn ich mit der Mouse bei einem Stop über die Variablen gehe, wird der Inhalt ja angezeigt, und es fehlt einfach der PDFName! In der Schleife funktioniert seltsamerweise nur der Durchlauf des 1. Datensatzes perfekt! Beim 2. Durchlauf gibt es eine Fehlermeldung 462. Ich stehe wieder auf dem Schlauch! Vielleicht kannst du nochmal helfen? Hängt es an dem Einfügen des outMail.Close (olSave) ? Ist es tatsächlich richtig, dieses vor dem Loop zu setzen und nicht vor dem  rs.MoveNext ?
Hier nochmal meine aktuelle VBA:
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 = PfadName
        outMail.Attachments.Add strFilename
        outMail.To = emailTo
        outMail.Subject = emailSubject
        'outMail.Body = emailText
        outMail.Display
        outMail.Save
   
'Stop
rs.MoveNext
        outMail.Close (olSave)
  Loop
rs.Close

[ToBu]

Hallo PhilS, nach einigen fehlgeschlagenen Versuchen habe ich nun endlich die bei mir funktionierende Position für die Anweisung outMail.Close (oISave) gefunden! Vielen Dank nochmals an dich und alle anderen für die Beiträge und Kommentare, die mich weitergebracht haben! Für alle Interessierten hier nun die Lösung der VBA Anwendung :
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 I                        As Integer

  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
I = 0
Set rs = db.OpenRecordset("SELECT KurzFirma, Land, Email FROM abf_Hersteller")
Do Until rs.EOF
  I = I + 1
      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 = PfadName
        outMail.Attachments.Add strFilename
        outMail.To = emailTo
        outMail.Subject = emailSubject
        outMail.Body = emailText
        outMail.Display
        outMail.Save
        outMail.Close (olSave)

rs.MoveNext
Loop
rs.Close
 
    Set rs = Nothing
    Set db = Nothing
   
    If outlookStarted Then
        outApp.Quit
    End If
   
    Set outMail = Nothing
    Set outApp = Nothing
MsgBox "Alle " & I & " Emails in Entwürfe gespeichert!"

End Sub

[PhilS]

nach einigen fehlgeschlagenen Versuchen habe ich nun endlich die bei mir funktionierende Position für die Anweisung outMail.Close (oISave) gefunden!

Dort wo du es jetzt hast, am Ende des Blocks zu outMail, ist es auch gut aufgehoben, weil es einen logischen Kontext zusammenfasst.
Für die Funktion des Codes macht es aber absolut überhaupt gar keinen Unterschied!
An den Problemen mit "nur ein Durchlauf" ändert das nichts.