Difference between revisions of "Microsoft Access modFso"
Jump to navigation
Jump to search
Line 21: | Line 21: | ||
If Err.Number = 76 And blnFirst Then | If Err.Number = 76 And blnFirst Then | ||
Debug.Print strPath & " not found - trying to create parent ..." | Debug.Print strPath & " not found - trying to create parent ..." | ||
− | + | assertPath fso.GetParentFolderName(strPath) | |
blnFirst = False | blnFirst = False | ||
Resume | Resume |
Latest revision as of 02:56, 4 December 2010
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 ..."
assertPath 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