Gelegentlicher Laufzeitfehler

Hallo,
ich habe eine Datei, mit der man Versanddaten erfassen kann, die dann per Makro in eine Tabelle übertragen werden, aus der sich diverse Formulare die entsprechenden Werte ziehen. Mit einem weiteren Makro kann man dann die benötigten Formulare drucken und mit einem weiteren als PDF erzeugen und direkt in eine Outlook-Mail setzen zzgl. einem Betreffe und TExtfeld. Hierbei bekomme ich des Öfteren einen Laufzeitfehler: 2147024894 (80070002)
Dazu finde ich zwar ein paar Google-Ergebnisse, aber da die dortigen Codes ganz anders sind als meine, komme ich nicht hinter den Fehler. Vielleicht kann man mir ja hier dazu weiterhelfen.
Komisch ist halt, dass es nicht immer so ist. Oft habe ich den Fehler, wenn ich eine weitere Excel geöffnet habe oder vorher bereits Excel genutzt habe. Manchmal ist der Fehler dann weg, wenn ich erst einen Windows Neustart mache. Bei manchen Einträgen bleibt der Fehler aber dauerhaft bestehen.
Mir wurde gesagt, ich müsse den Pfad mit angeben, an dem die PDFs erzeugt und gespeichert werden. Ich arbeite auf einem Firmenserver und die PDFs werden in einem Temp-Ordner hinterlegt (Pfad dazu habe ich nie gewählt, macht der einfach).

Debug markiert immer "myAttachments.Add DateiName1" in gelb.

Sub Gelangen_CMR_und_Senden()

Dim DateiName As String
    
  Sheets("CMR1").Select
    DateiName1 = "CMR " & Range("B17") & ".pdf"
    Range("A5:K90").ExportAsFixedFormat Type:=x1TypePDF, Filename:=DateiName1, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

  Sheets("Gelangen").Select
    DateiName2 = "ENTRY CERTIFICATE " & Range("K6") & ".pdf"
    Range("A5:H56").ExportAsFixedFormat Type:=xlTypePDF, Filename:=DateiName2, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
              
    Dim Outlook As Object
    Dim OutlookMailItem As Object
    Dim myAttachments As Object

    Set OutlookApp = CreateObject("Outlook.Application")
    Set OutlookMailItem = OutlookApp.CreateItem(0)
    Set myAttachments = OutlookMailItem.Attachments

  With OutlookMailItem
       .To = Range("K5")
       .CC = Range("M5")
       .Subject = "AVIS + ENTRY CERTIFICATE: " & Range("K6")
       .Body = Range("K8")
          myAttachments.Add DateiName1
          myAttachments.Add DateiName2
       .Display
  End With

  Set OutlookApp = Nothing
  Set OutlookMailItem = Nothing
  
  If ActiveSheet.Name = "Gelangen" Then
     Sheets("Eingabemaske").Select
     Range("C4").Select
  End If

End Sub