Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!
  • Students Click Here

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Microsoft: Access Modules (VBA Coding) FAQ

Access - Select Dialogs

How do select a file using the a dialog box. by m6
Posted: 20 Sep 02

Many have asked this so here it is from several contributors, thanks to all whom have replied to this repetttttative question.

Writing your own using the toolbox items is just not necessary.

There are many threads, but this works well.  I will start including others later.

Bear in mind that this is a class module and needs to be declared you code.

Sample code:
Dim cmdlgOpenFile As New clsCommonDialog
Dim FileName As String    'full file name
Const clngFilterIndexAll = 5

cmdlgOpenFile.Filter = "Text Files (*.txt)|*.txt|DBF Files (DBF)|*.dbf|All Files (*.*)|*.*"
cmdlgOpenFile.FilterIndex = clngFilterIndexAll
'this is where the dialog opens

'returns your full file name.
FileName = cmdlgOpenFile.FileName

'hence no len, no name...
If Len(FileName) = 0 Then Exit Sub

To your project add a class module named: clsCommonDialog

Option Explicit

'                     CommonDialog class                       '
'                                                              '
'      This module contains an interface to the Common         '
'      Dialog File Open/Save functions. It may be enhanced     '
'      for other Common Dialog functions at a future date.     '
'                                                              '
'      This object presents exactly the same interface as      '
'      the Microsoft Common Dialog 6.0 library from Visual     '
'      Basic 6.0 (comdlg32.dll).                               '
'                                                              '
' Values for the Flags property; multiple values can be ORed together.
' In versions of Access prior to Access 2000, comment or delete these
' and use the CommonDialogConstants module (Enum keyword is not
' valid in these versions).
Public Enum CmdlgOpenFlags
     cdlOFNAllowMultiselect = &H200
     cdlOFNCreatePrompt = &H2000
     cdlOFNExplorer = &H80000
     cdlOFNFileMustExist = &H1000
     cdlOFNHideReadOnly = &H4
     cdlOFNNoChangeDir = &H8
     cdlOFNNoDereferenceLinks = &H100000
     cdlOFNNoNetworkButton = &H20000     ' not documented for common dlg
     cdlOFNNoReadOnlyReturn = &H8000
     cdlOFNNoValidate = &H100
     cdlOFNOverwritePrompt = &H2
     cdlOFNPathMustExist = &H800
     cdlOFNReadOnly = &H1
     cdlOFNShowHelp = &H10
     cdlOFNShareAware = &H4000
     cdlOFNExtensionDifferent = &H400
End Enum

' Errors raised
Public Enum CmdlgErrors
    cdlCancel = 32755                   ' user pressed Cancel in dialog
End Enum

' Filter string used for the Open/Save dialog filters (the
' "Files of type" combo box). The string consists of a list of
' filter specs, each of which consists of a pair of elements.
' The first element of each spec is the description to appear
' in the combo box, and the second is a filter pattern. When
' the user selects the description, the corresponding pattern
' is used to filter the list of files in the file list box.
' A pipe character ("|") separates each element of the string.
' Example: "Database Files|*.mdb|All Files|*.*"
Public Filter As String
' Initial Filter to display. This sets/returns the index of the
' currently selected item in the filter combo box.
Public FilterIndex As Long
' Initial directory for the dialog to open in.
' Default = Current working directory.
Public InitDir As String
' Initial file name to populate the dialog with. Default = "".
' Returns the full path name of the selected file.
Public FileName As String
' Returns file name (without path) of file picked
Public FileTitle As String
' Title to appear on the dialog box.
Public DialogTitle As String
' Default extension to append to file if user didn't specify one.
Public DefaultExt As String
' Flags (see constant list) to be used.
' Returns cdlOFNDifferentExtension if extension present and not = DefaultExt
Public Flags As Long
' Maximum length of the file name to be returned
Public MaxFileSize As Integer
' Set to True to raise error 32755 if user cancels dialog box
Public CancelError As Boolean

' Constants used when raising errors
Private Const ErrSource = "MyComDlg.CommonDialog"

' Interface to Win32
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustrFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    lngFlags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustrData As Long
    lpfnHook As Long
    lpTemplateName As Long 'String
End Type

Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
    "GetOpenFileNameA" (pOpenfilename As W32_OPENFILENAME) As Boolean
Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias _
    "GetSaveFileNameA" (pOpenfilename As W32_OPENFILENAME) As Boolean

Private Sub Class_Initialize()
    ' Initialize the MaxFileSize to minimum, in case the user doesn't set it
    MaxFileSize = 256
End Sub

Public Sub ShowOpen()
' Shows the Open dialog
    Dim wofn As W32_OPENFILENAME
    Dim intRet As Integer

    OFN_to_WOFN wofn
    On Error GoTo ShowOpen_Error
    intRet = GetOpenFileName(wofn)
    On Error GoTo 0
    WOFN_to_OFN wofn
    If (intRet = 0) And CancelError Then _
        Err.Raise cdlCancel, ErrSource, "File open canceled by user"
    Exit Sub

    WOFN_to_OFN wofn
    Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, _
End Sub

Public Sub ShowSave()
' Shows the Save dialog
    Dim wofn As W32_OPENFILENAME
    Dim intRet As Integer

    OFN_to_WOFN wofn
    On Error GoTo ShowSave_Error
    intRet = GetSaveFileName(wofn)
    On Error GoTo 0
    WOFN_to_OFN wofn
    If (intRet = 0) And CancelError Then _
        Err.Raise cdlCancel, ErrSource, "File save canceled by user"
    Exit Sub

    WOFN_to_OFN wofn
    Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, _
End Sub

Private Sub OFN_to_WOFN(wofn As W32_OPENFILENAME)
' This sub converts from the Microsoft Access structure to the Win32 structure.
    ' Initialize some parts of the structure.
    With wofn
        .hwndOwner = Application.hWndAccessApp
        .hInstance = 0
        .lpstrCustomFilter = vbNullString
        .nMaxCustrFilter = 0
        .lpfnHook = 0
        .lpTemplateName = 0
        .lCustrData = 0
        .lpstrFilter = ConvertFilterString(Filter)
        .nFilterIndex = FilterIndex
        If MaxFileSize < 256 Then MaxFileSize = 256
        If MaxFileSize < Len(FileName) Then MaxFileSize = Len(FileName)
        .nMaxFile = MaxFileSize
        .lpstrFile = FileName & String(MaxFileSize - Len(FileName), 0)
        .nMaxFileTitle = 260
        .lpstrFileTitle = String(260, 0)
        .lpstrTitle = DialogTitle
        .lpstrInitialDir = InitDir
        .lpstrDefExt = DefaultExt
        .lngFlags = Flags
        .lStructSize = Len(wofn)
    End With
End Sub

Private Sub WOFN_to_OFN(wofn As W32_OPENFILENAME)
' This sub converts from the Win32 structure to the Microsoft Access structure.
    With wofn
        FileName = Left$(.lpstrFile, InStr(.lpstrFile, vbNullChar) - 1)
        FileTitle = Left$(.lpstrFileTitle, InStr(.lpstrFileTitle, vbNullChar) - 1)
        FilterIndex = .nFilterIndex
        Flags = .lngFlags
    End With
End Sub

Private Function ConvertFilterString(strFilterIn As String) As String
' Creates a Win32 filter string from a pipe ("|") separated string.
' The string should consist of pairs of filter|extension strings,
' i.e. "Access Databases|*.mdb|All Files|*.*"
' If no extensions exists for the last filter pair, *.* is added.
' This code will ignore any empty strings, i.e. "||" pairs.
' Returns "" if the string passed in is empty.
    Dim strFilter As String
    Dim intNum As Integer, intPos As Integer, intLastPos As Integer

    strFilter = ""
    intNum = 0
    intPos = 1
    intLastPos = 1

    ' Add strings as long as we find pipe characters
    ' Ignore any empty strings (not allowed).
        intPos = InStr(intLastPos, strFilterIn, "|")
        If (intPos > intLastPos) Then
            strFilter = strFilter & Mid(strFilterIn, intLastPos, intPos - intLastPos) & vbNullChar
            intNum = intNum + 1
            intLastPos = intPos + 1
        ElseIf (intPos = intLastPos) Then
            intLastPos = intPos + 1
        End If
    Loop Until (intPos = 0)
    ' Get last string if it exists (assuming strFilterIn was not bar terminated).
    intPos = Len(strFilterIn)
    If (intPos >= intLastPos) Then
        strFilter = strFilter & Mid(strFilterIn, intLastPos, intPos - intLastPos + 1) & vbNullChar
        intNum = intNum + 1
    End If
    ' Add *.* if there's no extension for the last string.
    If intNum Mod 2 = 1 Then
        strFilter = strFilter & "*.*" & vbNullChar
    End If
    ' Add terminating NULL
    ConvertFilterString = strFilter & vbNullChar
End Function

Back to Microsoft: Access Modules (VBA Coding) FAQ Index
Back to Microsoft: Access Modules (VBA Coding) Forum

My Archive

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close