VBA Unterordner Check

[PERKELE]

Gute Nacht zusammen,

ich probiere mich schon einige Zeit daran folgendes VBA Script zum laufen zu bekommen.

Es funktioniert soweit ganz gut, jedoch schmeißt er mir eine Fehlermeldung der Prüfung ob der jeweilig (gewünschte) Unterordner vorhanden ist.

Hier der Code:

Option Explicit

Public Sub modBeispiel()
'Definiere Variablen
'YR = Jahr
'KW = Kalenderwoche
'WD = WochenTag
'DY = Tag

'Definiere Ausgangsvariablen

    'Merke aktuellen Dateinamen
    Dim strAktWB As String
    strAktWB = ActiveWorkbook.Name
    
    'Merke Basis Pfad
    Dim strPfad As String
    strPfad = "*EXAMPLE*\Test\" 'DEV
    
    'Definiere FileName
    Dim strName As String
    strName = "Datei_"
    
    'Definiere Datum
    Dim strDY As String
    strDY = ThisWorkbook.Worksheets("Test").Range("A1")
    
    'Suche Kalenderwoche
    Dim strKW As String
    strKW = ThisWorkbook.Worksheets("Test").Range("A2")
    
    'Suche Wochentag
    Dim strWD As String
    strWD = ThisWorkbook.Worksheets("Test").Range("A3")
    
    'Suche Jahr
    Dim strYR As String
    strYR = ThisWorkbook.Worksheets("Test").Range("A4")
    
    'Fasse Strings Teil 1 zusammen
    Dim strAll As String
    strAll = strName & strKW & "_"
    
    'Fasse Strings Teil 2 zusammen
    Dim strAll2 As String
    strAll2 = strAll & strDY & ".xlsm"
    
    'String für Überordner
    Dim strPfadYR As String
    strPfadYR = strPfad & strYR
    
    'String für Unterordner
    Dim strPfadYRKW As String
    strPfadYRKW = strPfad & strYR & "\" & strKW
    
    'Check ob Überordner vorhanden
    If Dir(strPfadYR) = "" Then
        On Error GoTo Weiter
        MkDir (strPfadYR)
     
        Else
    
    GoTo Weiter

    End If
    
Weiter:
    'Check ob Unterordner vorhanden
    If Dir(strPfadYRKW) <> (strPfadYRKW) Then
        'On Error GoTo Weiter2
        MkDir (strPfadYRKW) *** DEBUG FEHLER
        
        Else
        
    GoTo Weiter2
    End If
    
Weiter2:
    
    'Ist es Sonntag?
    If (strWD) = "Sonntag" Then GoTo Sonntag Else
    
    GoTo Nope
    
    'Check ob aktuelle KW File vorhanden
    If Dir(strPfad) = "" Then
    
    'Unterdrücke Fehlermeldungen
    Application.DisplayAlerts = False
    
    'Open File
    Workbooks.Open strPfad
        GoTo Start
        
    Else
        
    GoTo Fehler
Start:
    If (strWD) = "Sonntag" Then GoTo Sonntag Else GoTo Fehler1A

End If
Nope:
MsgBox ("Du kannst dieses Makro nur an einem Sonntag ausführen!")
End

Sonntag:
MsgBox ("Check es ist Sonntag 'Call Makro'")
End

Fehler:
If MsgBox("Es ist ein interner Fehler aufgetreten!", vbOK + vbCritical, "Fehler") = vbOK Then
End If
End
End Sub

Vielleicht könntet Ihr mir auf Sprünge helfen.

In der Zeile "MkDir (strPfadYRKW) *** DEBUG FEHLER" tritt der Fehler auf, wenn der Ordner nicht vorhanden ist, läuft alles gut. Ist dieser vorhanden kommt es zu dem Laufzeitfehler 75.

Btw.: Einige Definitionen wurden Anonymisiert angepasst.

Ich danke im Voraus.

Viele Grüße,
Red-John

 

[Andreas_]

Wenn man mit Dir prüfen will, ob ein Verzeichnis existiert, dann muss man vbDirectory als zweiten Parameter übergeben. Siehe auch Dir-Funktion.

Also beispielsweise an Stelle von

If Dir(strPfadYR) = "" Then

neu

If Dir(strPfadYR, vbDirectory) = "" Then