'SaveAs' fehlgeschlagen

Hallo Ihr lieben,

ich hätte mal eine kleine frage/ bitte.
Ich habe eine Datei für meine Kollegen, wo per User-Form eine neue Datei in einen bestimmten Ordner erstellt wird.

Wie kann ich den Laufzeitfehler '1004': Die Methode 'SaveAs' für das Objekt ist fehlgeschlagen, umgehen und stattdessen eine MSG-Box anzeigen lassen mit ''Bitte zuerst Ordner XXXX anlegen", die dann das Makro/ Userform wieder beendet?

Mein Makro bisher:

Private Sub CBEintragen_Click()

    BearbeitungOeffnen

    Sheets("Allgemein").Range("Artikelbezeichnung") = TBArtikelbezeichnung.Text 
    Sheets("Allgemein").Range("Artikelnummer") = TBArtikelnummer.Text       

    'Dialogfeld "Speichern unter" aufrufen
    'und dabei den Dateipfad und den Dateinamen vorgeben

    BearbeitungSchliessen

    Dim strBlatt As String
    Dim strCALIBER As String
    
        '** Aktuelles aktives Blatt in neue Arbeitsmappe kopieren
        strBlatt = TBArtikelnummer.Text
        strCALIBER = CBKaliber.Text
        '** Blatt in vorgegebenes Verzeichnis abspeichern
        ChDir "K:\XXXXX"
        ActiveWorkbook.SaveAs Filename:="K:\XXXXX\" + strCALIBER + "\" + strBlatt + ".xlsm", FileFormat:= _
        xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
        
    Unload Me
          
        BearbeitungOeffnen  'Schreibschutz aufheben
   
        'Löscht den Button nach dem Erfolgreichen erstellen des Logbuchs
        ActiveSheet.Range("L4") = Now
        ActiveSheet.Range("K4") = Date$
        ActiveSheet.Shapes.Range(Array("CBERSTELLEN")).Select   '(SCHRITT 1) Schaltfläche wird gelöscht
        Selection.Delete
           
        BearbeitungSchliessen   'Schreibschutz eintragen
        
        ActiveWorkbook.Close savechanges:=True 'Vorlage wird gespeichert und geschlossen
        Application.Close
        

End Sub