Difference between revisions of "Microsoft Access modFso"
Jump to navigation
Jump to search
(Created page with '=== assertPath === <syntaxhighlight lang="vb"> Sub assertPath(strPath) Dim fso As FileSystemObject Dim blnFirst As Boolean blnFirst = True Set fso = New File...') |
|||
(4 intermediate revisions by the same user not shown) | |||
Line 1: | Line 1: | ||
+ | [[Category:Microsoft Access]] | ||
+ | [[Category:VBA]] | ||
=== assertPath === | === assertPath === | ||
<syntaxhighlight lang="vb"> | <syntaxhighlight lang="vb"> | ||
− | Sub assertPath(strPath) | + | Public Sub assertPath(strPath) |
Dim fso As FileSystemObject | Dim fso As FileSystemObject | ||
Dim blnFirst As Boolean | Dim blnFirst As Boolean | ||
Line 19: | 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 | ||
Line 26: | Line 28: | ||
End If | End If | ||
End Sub | End Sub | ||
+ | </syntaxhighlight> | ||
+ | |||
+ | === selectFile === | ||
+ | <syntaxhighlight lang="vb"> | ||
+ | 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 | ||
+ | </syntaxhighlight> | ||
+ | |||
+ | ==== selectDatabase ==== | ||
+ | <syntaxhighlight lang="vb"> | ||
+ | Public Function selectDatabase(Optional strFilePathDefault As String = "") As String | ||
+ | Dim strResult As String | ||
+ | |||
+ | strResult = selectFile("Microsoft Access", "*.mdb", strFilePathDefault) | ||
+ | |||
+ | selectDatabase = strResult | ||
+ | End Function | ||
+ | </syntaxhighlight> | ||
+ | |||
+ | ==== selectSpreadsheet ==== | ||
+ | <syntaxhighlight lang="vb"> | ||
+ | Public Function selectSpreadsheet(Optional strFilePathDefault As String = "") As String | ||
+ | Dim strResult As String | ||
+ | |||
+ | strResult = selectFile("Microsoft Excel", "*.xls", strFilePathDefault) | ||
+ | |||
+ | selectSpreadsheet = strResult | ||
+ | End Function | ||
+ | </syntaxhighlight> | ||
+ | |||
+ | === selectFolder === | ||
+ | <syntaxhighlight lang="vb"> | ||
+ | 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 | ||
</syntaxhighlight> | </syntaxhighlight> |
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