You can use the comdlg32.dll as follows:
Public Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (lpOpenFilename As OPENFILENAME) As Long
Public Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (lpOpenFilename As OPENFILENAME) As Long
'TYPE: OPENFILENAME
'DESCRIPTION: Used by GetOpenFileName and GetSaveFileName API Call. Used to store settings for the Open File Window
'________________________________________________________________________________________________________________________________
Public Type OPENFILENAME
lStructSize As Long 'Size of the structure. Set this to the value returned from Len(x).
hwndOwner As Long 'Handle to the owner of this dialog. Use Application.hWndAccessApp
hInstance As Long 'Instance of the application. Use 0.
lpstrFilter As String 'The filter of the file types displayed in the Files of Type field. This string must be terminated with two null characters.
lpstrCustomFilter As String 'This parameter is a pointer to a buffer used to preserve the filter pattern chosen by the user.
nMaxCustFilter As Long 'The size in bytes of the buffer in lpstrCustomFilter.
nFilterIndex As Long 'The index of the filter you wish to set as the default.
lpstrFile As String 'The fully qualified path name of the file used to initialize the dialog. If you use this member, it must be preceded with a null character.
nMaxFile As Long 'The size in bytes of the buffer used for lpstrFile.
lpstrFileTitle As String 'Pointer to the buffer that receives the path and filename selected by the user.
nMaxFileTitle As Long 'Maximum length of the buffer specified in lpstrFileTitle.
lpstrInitialDir As String 'A string containing the initial directory. If this value is null, then the current directory is used. On Windows 2000 and Windows 98, if this value is null and the current directory contains files that match the specified file filter, the current directory is used. If no files match, the user's personal file directory of the current user is used.
lpstrTitle As String 'Caption of the dialog.
flags As Long 'A set of options used to configure the dialog. The flags are constants that begin with OFN_.
nFileOffset As Integer 'Specifies the number of bytes to the first character in the filename. This allows you to extract the filename from the path. Since the number is zero-based, subtract one from the value returned in this member.
nFileExtension As Integer 'Specifies the number of bytes to the first character of the file extension. Since the number is zero-based, subtract one from the value returned in this member.
lpstrDefExt As String 'Default extension of the file. Used when called by GetSaveFileName.
lCustData As Long 'Custom data passed to the message handler specified in the lpfnHook member.
lpfnHook As Long 'The address of the hook procedure. To enable a message hook, set the OFN_ENABLEHOOK flag in addition to any other flags.
lpTemplateName As String 'Pointer to a string that names the template dialog included in the resource specified by the hInstance member.
End Type
Public Function gsGetFileName(psDialogTitle As String, pbSaveDialog As Boolean, pbOpenDialog As Boolean, Optional psSaveFileType As String, Optional psInitialDir As String) As String
Dim liReturnCode As Long
Dim lpOpenFilename As OPENFILENAME
Dim lsInitialDir As String
Dim lsInitialDirWithFile As String
Dim lsFilterDesc As String
Dim lsFilterPattern As String
Dim lsFileName As String
Dim lsSaveFileType As String
Dim liUptoDot As Integer
Dim liLength, listring As Integer
Dim lsString As String
Dim lsDatabaseName As String
Const MAX_BUFFER_LENGTH = 256
On Error GoTo GetFileName_Error
'CHECK THAT SAVE OR OPEN HAS BEEN INDICATED BUT NOT BOTH
If pbSaveDialog And pbOpenDialog Then
MsgBox "Please indicate that you want either the 'Save' or 'Open' Dialogs! Not Both.", vbCritical, "Error Getting File Name"
End If
If Not pbSaveDialog And Not pbOpenDialog Then
MsgBox "Please indicate that you want either the 'Save' or 'Open' Dialogs! ", vbCritical, "Error Getting File Name"
End If
'SET THE DEFAULT SAVE FILE TYPE
If IsNull(psSaveFileType) Then
lsSaveFileType = ""
Else
lsSaveFileType = psSaveFileType
End If
With lpOpenFilename
.hwndOwner = Application.hWndAccessApp
.hInstance = 0
.lpstrTitle = psDialogTitle
.lpstrInitialDir = psInitialDir
.lpstrFilter = "All Files" & " " & "*.*" & " "
.nFilterIndex = 1
If pbSaveDialog Then
.lpstrDefExt = ".txt"
End If
.lpstrFile = String(MAX_BUFFER_LENGTH, 0)
.nMaxFile = MAX_BUFFER_LENGTH - 1
.lpstrFileTitle = .lpstrFile
.nMaxFileTitle = MAX_BUFFER_LENGTH - 1
.lStructSize = Len(lpOpenFilename)
End With
If pbOpenDialog Then
liReturnCode = GetOpenFileName(lpOpenFilename)
Else
liReturnCode = GetSaveFileName(lpOpenFilename)
End If
If liReturnCode Then
'A file selected
lsFileName = Left$(lpOpenFilename.lpstrFile, lpOpenFilename.nMaxFile)
'Remove the null chars
lsFileName = Left(lsFileName, InStr(lsFileName, vbNullChar) - 1)
Else
'The cancel button was pressed
lsFileName = ""
End If
GetFileName_Exit:
gsGetFileName = lsFileName
Exit Function
GetFileName_Error:
MsgBox Err.Description, vbInformation, "Error Getting FileName"
Resume GetFileName_Exit
End Function
Call the function like this:
Public Sub test()
Dim lsFileName As String
lsFileName = gsGetFileName("Get File", False, True, , "c:\"
End Sub
