Prüfen ob Pfad existiert wenn nicht erstellen

Private Sub Speichern()
Dim strDate As String
Dim strGeneralDir As String
Dim strYearDir As String
Dim strpath As String
Dim strNameDir As String
Dim strMonthDir As String

strDate = Format(Now, "mm.yy")
strYearDir = Format(Now, "yyyy")
strGeneralDir = "c:\Unternehmensplanung\Projekte"
strNameDir = "Kat.D" & " " & Workbooks("Unternehmensplanung - Einzelprojekt.xls").Worksheets("Projektdaten").cells(5, 2)
strpath = strGeneralDir & " " & strYearDir

If Not PathExists(strpath) Then MkDir (strpath)

ThisWorkbook.SaveAs (strpath & "\" & strNameDir & " " & strDate & ".xls")

MsgBox ("Arbeitsmappe wird gespeichert in:" + Chr(13) + strpath & "\" & strNameDir & ".xls")

Worksheets("Tabelle").Activate

End Sub

Private Function PathExists(strpath) As Boolean
Dim x As String
On Error Resume Next
x = GetAttr(strpath) And 0
If Err = 0 Then
PathExists = True
ElseIf PathExists = False Then
End If
End Function

Das makro soll überpüfen ob der Ordner Projekte 2002 (aktuelles Jahr) existiert wenn ja dann soll er eine Arbeitsmappe drin speichern wenn nicht dann soll er den Ordner erzeugen und dann die Arbeitsmappe drin speichern.

Das Makro funktionniert aber nicht.
Was kann ich ändern oder wie kann ich das Problem ändern.

Danke im Voraus.
Steve