Excel 2007 workbook corrupted during save

[smiler44]

I have written a maro that runs when a workbook is opened, creates a directory structure and saves it's self into the directoy. If I close the workbook without saving when I try to open the workbook I get

"Excel can not open the file "Dashboard.xlsm" because the file format or file extention is not valid. verify that the file has not been corrupted and that the file extention matches the format of the file."

file struture is C:\...my documents\Dashboard\finance\files
with the workbook saving into the finance directory


I can not work out what is going wrong but here is the code I'm using in case it helps

Sub createstructure()
        ' check if dashbaord and finance files directory exist. if they dont it creates them
        'and saves itself into the finance directory
        Dim directoryfound As String
        Const errpathnotfound As Integer = 76
        Dim handleErr
        Dim pat As String  ' my documents path
        Dim dirr As String  ' main directory
        Dim subdirr As String '1st sub directory
        Dim subbdir As String '2nd sub directory
        Dim fle As String 'file to save
        
        pat = SpecFolder(CSIDL_PERSONAL)
        dirr = "\Dashboard" ' main directory
        subdirr = "\Finance" ' first sub directory
        subbdir = "\Files" ' 2nd sub directory
        fle = "\Dashboard.xlsm" ' file to save
                
        strpathname = pat & dirr
        On Error GoTo 0
        
        directoryfound = Dir(strpathname, vbDirectory)
        If (Len(directoryfound)) = 0 Then ' directory not found
             MkDir pat & dirr 'makes Dashboard directory
        End If
        
        directoryfound = "" ' set directoryfound to nothing
        
        directoryfound = Dir(strpathname & subdirr, vbDirectory)
       If (Len(directoryfound)) = 0 Then
               MkDir pat & dirr & subdirr ' makes finance directory and saves its self into it
             ActiveWorkbook.SaveAs pat & dirr & subdirr & fle,    FileFormat:=xlNormal
        End If
        
        directoryfound = "" ' set directoryfound to nothing
        
        directoryfound = Dir(strpathname & subdirr & subbdir, vbDirectory)
        
        If (Len(directoryfound)) = 0 Then ' directory not found
                MkDir pat & dirr & subdirr & subbdir ' makes file directory
        End If
        'saves work book into dashboard\finance directory
        
0
        Exit Sub
        End Sub
 
 
Public Declare Function SHGetSpecialFolderLocation _
            Lib "shell32" (ByVal hWnd As Long, _
            ByVal nFolder As Long, ppidl As Long) As Long
        
        Public Declare Function SHGetPathFromIDList _
            Lib "shell32" Alias "SHGetPathFromIDListA" _
            (ByVal Pidl As Long, ByVal pszPath As String) As Long
        
        Public Declare Sub CoTaskMemFree Lib "ole32" (ByVal pvoid As Long)
            
        Public Const CSIDL_PERSONAL = &H5
        Public Const CSIDL_DESKTOPDIRECTORY = &H10
        Public Const MAX_PATH = 260
        Public Const NOERROR = 0
        
        Public Function SpecFolder(ByVal lngFolder As Long) As String
        ' See [URL]http://msdn.microsoft.com/en-us/library/aa140088(office.10).aspx[/URL] for details
        ' SpecFolder(CSIDL_PERSONAL) gets My Docuemnts
        ' SpecFolder(CSIDL_DESKTOPDIRECTORY) gets the desktop
        
        Dim lngPidlFound As Long
        Dim lngFolderFound As Long
        Dim lngPidl As Long
        Dim strPath As String
        
        strPath = Space(MAX_PATH)
        lngPidlFound = SHGetSpecialFolderLocation(0, lngFolder, lngPidl)
        If lngPidlFound = NOERROR Then
            lngFolderFound = SHGetPathFromIDList(lngPidl, strPath)
            If lngFolderFound Then
                SpecFolder = Left$(strPath, _
                    InStr(1, strPath, vbNullChar) - 1)
            End If
        End If
        CoTaskMemFree lngPidl
        End Function

smiler44

 

[HaHoBe]

Hi, smiler44,

ActiveWorkbook.SaveAs pat & dirr & subdirr & fle, FileFormat:=xlNormal

xlNormal isn´t the choice for an *.xlsm which would be xlOpenXMLWorkbookMacroEnabled. Please have a look at Use VBA SaveAs in Excel 2007 or use the macro recorder to get the code.

Ciao,
Holger

 

[smiler44]

Bugger. I thought I recorded a macro to save as and checked it. I bet I only read about half of it and seeing it was the same gave up thinking that it was not the problem.

Thank you Holger, more like thank you, again, for coming to my rescue.
smiler44