Makro virker ikke i Excel 2007 og 2010 format

Nedenstående Sub fungerer hvis den køres i i Excel 2003 format i Excel 2007 og 2010 (.xls i stedet for .xlsm), men den fungerer ikke i Excel 2007 og Excel 2010 format. Den kommer bare ud med meddelelsen i Err1 og filen bliver ikke gemt!
Er der nogen der kan forklare mig hvorfor?

Funktionen nedenunder fungerer som den skal. Den opretter den ønskede mappestruktur, også når den køres i Excel 2007 format.

-----------------------------------------------------------------

Private Sub S_Exist()
'****************************************
'* Gemmer regnskabet i en mappe og med  *
'*  et navn bestemt af Beboernavn og  *
'*  Startdato hvis Drev S eksisterer    *
'****************************************
    On Error GoTo Err1
    Application.DisplayAlerts = False
    With Sheets("Kassebog")
        ActiveWorkbook.SaveAs CheckMakePath("S:\Boinstitutionen Højsletten\" & Sheets("Kassebog").Range("i4").Text & "-huset" & "\" & "Beboere" _
        & "\" & Sheets("Kassebog").Range("E2").Text & "\" & "Regnskab" & "\" _
        & Format(Sheets("Kassebog").Range("A4"), "yyyy")) & "Regnskab " & Format(Sheets("Kassebog").Range("A4"), _
        "mm-yyyy") & " " & Sheets("Kassebog").Range("E2").Text & ".xlsm"
    End With
'    MsgBox "                Regnskabet er gemt" + Chr(10) + "i beboerens regnskabsmappe på S:-drevet"
    Exit Sub
Err1:
    MsgBox "Regnskabet blev ikke gemt" + Chr(10) + "'Gem'-handlingen blev annulleret.", vbExclamation, ""
    Exit Sub
End Sub

-----------------------------------------------------------------

Function CheckMakePath(ByVal vPath As String) As String
    Dim PathSep As Long, oPS As Long
    If Right(vPath, 1) <> "\" Then vPath = vPath & "\"
    PathSep = InStr(3, vPath, "\")
    If PathSep = 0 Then Exit Function
    Do
        oPS = PathSep
        PathSep = InStr(oPS + 1, vPath, "\")
        If PathSep = 0 Then Exit Do
        If Len(Dir(Left(vPath, PathSep), vbDirectory)) = 0 Then Exit Do
    Loop
    Do Until PathSep = 0
        MkDir Left(vPath, PathSep)
        oPS = PathSep
        PathSep = InStr(oPS + 1, vPath, "\")
    Loop
    CheckMakePath = vPath
End Function

-----------------------------------------------------------------