Einen schönen guten Abend Gemeinde

ich möchte Tabellenblätter als PDF mit VBA speichern.

Ich sehe gerade den Wald vor lauter Bäumen nicht und mache dadurch Fehler.

Es existiert auf meiner Festplatte ein Ordner Archiv "C:\Users\info\Desktop\XXX\Archiv\" mit den "Maschinennummern", in den jeweiligen Ordnern gibt es Unterordner, zb. " Montageberichte" im ersten Fall soll Excel das Tabellenblatt "BMB" nach vorheriger suche aufgrund von M9 in "BMB!" im gefundenen Unterordner, " Montageberichte" den Druckbereich als PDF speichern/ drucken mit einem vordefinierten Dateinamen (jjjj-mm-tt. BMB. "Maschinennummern aus M9". "Kundenname aus B8" und "Ort aus D10" speichern / drucken. wenn die "Maschinennummern" Im Tabellenblatt BMB M9 nicht als Ordner im Verzeichnis "C:\Users\info\Desktop\XXX\Archiv\" existiert soll ein Ordner "Leeres Archiv" von "C:\Users\info\Desktop\XXX\Leeres Archiv" kopiert und umbenannt zur "Maschinennummern" BMB M9.
Das funktioniert auch gut mit diesem VBA Code:

Sub Speicher_BMB_als_PDF_im_Archiv()
Dim suchKriterium As String
Dim ordnerPfad As String
Dim fso As Object
Dim pdfPfad As String
Dim dateiname As String
Dim leerArchivePfad As String
Dim neuerOrdnerPfad As String

' Suchkriterium aus Zelle M9 BMB
suchKriterium = ThisWorkbook.Sheets("BMB").Range("M9").Value
ordnerPfad = "C:\Users\info\Desktop\XXX\Archiv\"
LeeresArchivPfad = "C:\Users\info\Desktop\XXX\Leeres Archiv"

' FileSystemObject erstellen
Set fso = CreateObject("Scripting.FileSystemObject")

' Überprüfen, ob der Ordner existiert
If fso.FolderExists(ordnerPfad & suchKriterium) Then
MsgBox "Der Kunde '" & suchKriterium & "' wurde im Archiv gefunden!", vbInformation
Else
MsgBox "Der Kunde '" & suchKriterium & "' wurde nicht im Archiv gefunden.", vbExclamation

' Ordner "Leeres Archiv" kopieren und umbenennen
If fso.FolderExists(LeeresArchivPfad) Then
neuerOrdnerPfad = ordnerPfad & suchKriterium
fso.CopyFolder LeeresArchivPfad, neuerOrdnerPfad
MsgBox "Der Ordner 'Leeres Archiv' wurde kopiert und umbenannt zu '" & suchKriterium & "'.", vbInformation
Else
MsgBox "Der Ordner 'Leeres Archiv' existiert nicht.", vbExclamation
End If
End If

' Dateinamen für die PDF erstellen
dateiname = Format(Date, "yyyy-mm-dd") & ". " & _
ThisWorkbook.Sheets("BMB").Range("M9").Value & ". " & _
"BMB" & ". " & _
ThisWorkbook.Sheets("BMB").Range("B8").Value & " " & _
ThisWorkbook.Sheets("BMB").Range("D10").Value & ".pdf"

' PDF-Pfad festlegen
pdfPfad = ordnerPfad & suchKriterium & "\Montageberichte\" & dateiname

' Tabellenblatt BMB als PDF speichern
ThisWorkbook.Sheets("BMB").ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdfPfad, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

MsgBox "Das BMB wurde erfolgreich als PDF zum Kunden im Archiv gespeichert: " & pdfPfad, vbInformation

' Objekte freigeben
Set fso = Nothing
End Sub

habe aber seit einiger Zeit eine weiteres Tabellenblatt "LMRA" Last Minute Risk Analysis, dafür soll ein in dem gesuchten Ordner ein "neuer Ordner" mit der Bezeichnung LMRA als Unterordner erstellt werden, im gesuchten Ordner und da das Protokoll mit ähnlichen Dateinamen (Aus "BMB" wird "LMRA") als PDF gespeichert werden.

somit habe ich den Code erweitert,
leider klappt er nicht

VBA Code für LMRA:

Sub Speicher_LMRA_als_PDF_im_Archiv()
Dim suchKriterium As String
Dim ordnerPfad As String
Dim fso As Object
Dim pdfPfad As String
Dim dateiname As String
Dim leerArchivePfad As String
Dim neuerOrdnerPfad As String

' Suchkriterium aus Zelle L9 LMRA
suchKriterium = ThisWorkbook.Sheets("LMRA").Range("L9").Value
ordnerPfad = "C:\Users\info\Desktop\XXX\Archiv\"
LeeresArchivPfad = "C:\Users\info\Desktop\XXX\Leeres Archiv"

' FileSystemObject erstellen
Set fso = CreateObject("Scripting.FileSystemObject")

' Überprüfen, ob der Ordner existiert
If fso.FolderExists(ordnerPfad & suchKriterium) Then
MsgBox "Der Kunde '" & suchKriterium & "' wurde nicht im Archiv gefunden!", vbInformation
Else
MsgBox "Der Kunde '" & suchKriterium & "' wurde nicht im Archiv gefunden.", vbExclamation

' Ordner "Leeres Archiv" kopieren und umbenennen
If fso.FolderExists(LeeresArchivPfad) Then
neuerOrdnerPfad = ordnerPfad & suchKriterium
fso.CopyFolder LeeresArchivPfad, neuerOrdnerPfad
MsgBox "Der Ordner 'Leeres Archiv' wurde kopiert und umbenannt zu '" & suchKriterium & "'.", vbInformation

' Ordner "LMRA" erstellen
Dim lrmaOrdnerPfad As String
lrmaOrdnerPfad = neuerOrdnerPfad & "\LMRA\"
If Not fso.FolderExists(lrmaOrdnerPfad) Then
fso.CreateFolder lrmaOrdnerPfad
MsgBox "Der Ordner 'LMRA' wurde erstellt.", vbInformation
End If
Else
MsgBox "Der Ordner 'Leeres Archiv' existiert nicht.", vbExclamation
End If
End If

' Dateinamen für die PDF erstellen
dateiname = Format(Date, "yyyy-mm-dd") & ". " & _
ThisWorkbook.Sheets("LMRA").Range("L9").Value & ". " & _
"LMRA" & ". " & _
ThisWorkbook.Sheets("LMRA").Range("B8").Value & " " & _
ThisWorkbook.Sheets("LMRA").Range("D10").Value & ".pdf"

' PDF-Pfad festlegen
pdfPfad = ordnerPfad & suchKriterium & "\LMRA\" & dateiname

' Tabellenblatt LMRA als PDF speichern
ThisWorkbook.Sheets("LMRA").ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdfPfad, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

MsgBox "Das LMRA wurde erfolgreich als PDF zum Kunden im Archiv gespeichert: " & pdfPfad, vbInformation

' Objekte freigeben
Set fso = Nothing
End Sub

abgebrochen wird im Code bei:

' Tabellenblatt LMRA als PDF speichern
ThisWorkbook.Sheets("LMRA").ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdfPfad, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

wenn ich im Explorer nach dem "neuen Ordner" im Verzeichnis suche, sehe ich dass kein "neuer Ordner" namens LMRA angelegt wurde, da denke ich dass da das Problem lieg, Excel kann keine Datei als PDF Speiern wenn der Ordner nicht angelegt oder erstellt wurde.

erstelle ich einen neuen Ordner "LMRA" im gesuchten Verzeichnis Manuell, funktioniert der Code wider Einwand frei, so wie auch bei dem VBA Code für "BMB", der Unterordner " Montageberichte" existiert in allen Unterordnern und wenn die "Maschinennummer aus (BMB M9 oder LMRA L9 nicht vorhanden ist) wird ein kompletter Satz mit allen Unterordnern Kopiert).

Lasse ich Excel jede "Maschiennummer" BMB = M9 oder LMRA L9, als neu erkennen sind meine alten Protokolle weg.

somit möchte ich nur meine alten Ordner aus dem Archiv erweitern um einen neuen Ordner "LMRA" zu generieren und das neue Protokoll, hinzufügen.

da sage ich schon mal Danke für eure Aufmerksamkeit und die Antworten

Gruß
Stefan .