Microsoft Access modFso

From database24
Jump to navigation Jump to search

assertPath

Public Sub assertPath(strPath)
    Dim fso As FileSystemObject
    Dim blnFirst As Boolean
    
    blnFirst = True
    Set fso = New FileSystemObject
    With fso
        If Not .FolderExists(strPath) Then
            On Error GoTo handleCreateFolderError
            .CreateFolder strPath
            On Error GoTo 0
        End If
    End With
    Exit Sub
    
handleCreateFolderError:
    If Err.Number = 76 And blnFirst Then
        Debug.Print strPath & " not found - trying to create parent ..."
        assurePath fso.GetParentFolderName(strPath)
        blnFirst = False
        Resume
    Else
        MsgBox "The path '" & strPath & "' could not be found, nor created.", vbExclamation + vbOKOnly
    End If
End Sub

selectFile

Public Function selectFile(strFileType As String, strFileTypeExtension As String, Optional strFileDefault As String = "")
    Dim strResult As String

    Dim dlg As FileDialog
    Dim strFile As String
    Dim fso As FileSystemObject
    
    Set fso = New FileSystemObject
    Set dlg = Application.FileDialog(msoFileDialogFilePicker)
    With dlg
        .Title = "File Selection"
        .AllowMultiSelect = False
        With .Filters
            .Clear
            .Add strFileType, strFileTypeExtension
        End With
        .InitialView = msoFileDialogViewDetails
        
        strFile = strFileDefault
        If fso.FileExists(strFile) Then
            .InitialFileName = fso.GetParentFolderName(strFile) & "\"
        Else
            .InitialFileName = ""
        End If
        
        If .Show = -1 Then
            strFile = LCase(.SelectedItems(1))
            If fso.FileExists(strFile) Then
                strResult = strFile
            End If
        End If
    End With
    
    selectFile = strResult
End Function

selectDatabase

Public Function selectDatabase(Optional strFilePathDefault As String = "") As String
    Dim strResult As String
    
    strResult = selectFile("Microsoft Access", "*.mdb", strFilePathDefault)

    selectDatabase = strResult
End Function

selectSpreadsheet

Public Function selectSpreadsheet(Optional strFilePathDefault As String = "") As String
    Dim strResult As String
    
    strResult = selectFile("Microsoft Excel", "*.xls", strFilePathDefault)

    selectSpreadsheet = strResult
End Function

selectFolder

Public Function selectFolder(Optional strFolderDefault As String = "")
    Dim strResult As String

    Dim dlg As FileDialog
    Dim strFolder As String
    Dim fso As FileSystemObject
    
    Set fso = New FileSystemObject
    Set dlg = Application.FileDialog(msoFileDialogFolderPicker)
    With dlg
        .Title = "Folder Selection"
        .AllowMultiSelect = False
        .InitialView = msoFileDialogViewDetails
        
        strFolder = strFolderDefault
        If fso.FolderExists(strFolder) Then
            .InitialFileName = strFolder
        Else
            .InitialFileName = ""
        End If
        
        If .Show = -1 Then
            strFolder = LCase(.SelectedItems(1))
            If fso.FolderExists(strFolder) Then
                strResult = strFolder
            End If
        End If
    End With
    
    selectFolder = strResult
End Function