Open File Dialog 1

[dazzer123]

How can I use an Open File Dialogue box from within VBA to return the path to a file (with extension *.doc)

 

[hymn]

do a search on common dialogue box

Hope this helps
Hymn

 

[dazzer123]

Yeah sorry about that, I just did a search and found loads

 

[hymn]

No problems
We assume when we reply to threads you know exactly what you want

Hope this helps
Hymn

 

[idbr]

Hi Dazzer123,

This is one way to do it, if rather complex:

Paste this into a module:

NB: Apologies, but a lot of these are redundant, but I ripped them straight from my public module and don't have the time to edit!

Option Compare Database
Option Explicit

' Public types are defined here.
Public Type OPENFILENAME
    lStructSize As Long
    hWndOwner As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustomFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type

Public Type BROWSEINFO
    hWndOwner As Long
    pidlRoot As Long
    pszDisplayName As String
    lpszTitle As String
    ulFlags As Long
    lpfn As Long
    lParam As Long
    iImage As Long
End Type

Public Type FileTime
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

Public Type WIN32_FIND_DATA
    dwFileAttributes As Long
    ftCreationTime As FileTime
    ftLastAccessTime As FileTime
    ftLastWriteTime As FileTime
    nFileSizeHigh As Long
    nFileSizeLow As Long
    dwReserved0 As Long
    dwReserved1 As Long
    cFileName As String * 260
    cAlternate As String * 14
End Type

Public Type STARTUPINFO
    cb As Long
    lpReserved As String
    lpDesktop As String
    lpTitle As String
    dwX As Long
    dwY As Long
    dwXSize As Long
    dwYSize As Long
    dwXCountChars As Long
    dwYCountChars As Long
    dwFillAttribute As Long
    dwFlags As Long
    wShowWindow As Long
    cbReserved2 As Long
    lpReserved2 As Long
    hStdInput As Long
    hStdOutput As Long
    hStdError As Long
End Type

Public Type PROCESS_INFORMATION
    hProcess As Long
    hThread As Long
    dwProcessId As Long
    dwThreadID As Long
End Type

' Public constants are defined here.
Public Const OFN_ALLOWMULTISELECT As Long = &H200
Public Const OFN_CREATEPROMPT As Long = &H2000
Public Const OFN_ENABLEHOOK As Long = &H20
Public Const OFN_ENABLETEMPLATE As Long = &H40
Public Const OFN_ENABLETEMPLATEHANDLE As Long = &H80
Public Const OFN_EXPLORER As Long = &H80000
Public Const OFN_EXTENSIONDIFFERENT As Long = &H400
Public Const OFN_FILEMUSTEXIST As Long = &H1000
Public Const OFN_HIDEREADONLY As Long = &H4
Public Const OFN_LONGNAMES As Long = &H200000
Public Const OFN_NOCHANGEDIR As Long = &H8
Public Const OFN_NODEREFERENCELINKS As Long = &H100000
Public Const OFN_NOLONGNAMES As Long = &H40000
Public Const OFN_NONETWORKBUTTON As Long = &H20000
Public Const OFN_NOREADONLYRETURN As Long = &H8000&
Public Const OFN_NOTESTFILECREATE As Long = &H10000
Public Const OFN_NOVALIDATE As Long = &H100
Public Const OFN_OVERWRITEPROMPT As Long = &H2
Public Const OFN_PATHMUSTEXIST As Long = &H800
Public Const OFN_READONLY As Long = &H1
Public Const OFN_SHAREAWARE As Long = &H4000
Public Const OFN_SHAREFALLTHROUGH As Long = 2
Public Const OFN_SHAREWARN As Long = 0
Public Const OFN_SHARENOWARN As Long = 1
Public Const OFN_SHOWHELP As Long = &H10

Public Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (lpofn As OPENFILENAME) As Long
Public Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (lpofn As OPENFILENAME) As Long

paste this into a second module:

Public Function DialogBox(ByVal title As String, Optional ByVal filter As String = "all", Optional ByVal style As String = "open", Optional ByVal deffile As String, Optional ByVal initialdir As String = "C:\", Optional ByVal multiple As Boolean = False) As String
' This pops an open or save as file dialog box with the passed in title and filtered according to the (optional)
' passed in extension with the optional passed in default filename displayed.  The selected filename is returned.
    
    Dim filebox As OPENFILENAME  ' open file dialog structure
    Dim Result As Long           ' result of opening the dialog
    Dim filter_num As Integer    ' the number of the default filter
    
    Select Case filter
    
        Case "txt"
        
            filter_num = 1
            
        Case "xls"
        
            filter_num = 2
        
        Case "mdb"
        
            filter_num = 3
            
        Case "doc"
        
            filter_num = 4
            
        Case "spl"
        
            filter_num = 5
        
        Case "all"
        
            filter_num = 6
            
        Case Else
        
            filter_num = 6
        
    End Select
    
    ' Configure how the dialog box will look
    With filebox
        ' Size of the structure.
        .lStructSize = Len(filebox)
        ' Handle to window opening the dialog.
        '.hwndOwner = 333
        ' Handle to calling instance (not needed).
        '.hInstance = 0
        ' File filters to make available.
        .lpstrFilter = "Text Files (*.txt)" & vbNullChar & "*.txt" & vbNullChar & _
            "Microsoft Excel (*.xls)" & vbNullChar & "*.xls" & vbNullChar & _
            "Microsoft Access (*.mdb)" & vbNullChar & "*.mdb" & vbNullChar & _
            "Microsoft Word (*.doc)" & vbNullChar & "*.doc" & vbNullChar & _
            "Spool files (*.spl)" & vbNullChar & "*.spl" & vbNullChar & _
            "All Files (*.*)" & vbNullChar & "*.*" & vbNullChar & vbNullChar
        '.lpstrCustomFilter is ignored -- unused string
        .nMaxCustomFilter = 0
        ' Default filter based on passed in extension.
        .nFilterIndex = filter_num
        ' No default filename.  Also make room for received
        ' path and filename of the user's selection.
        .lpstrFile = deffile & Space(1024) & vbNullChar
        .nMaxFile = Len(.lpstrFile)
        ' Make room for filename of the user's selection.
        .lpstrFileTitle = Space(1024) & vbNullChar
        .nMaxFileTitle = Len(.lpstrFileTitle)
        ' Initial directory is initialdir.
        .lpstrInitialDir = initialdir & vbNullChar
        ' Title of file dialog.
        .lpstrTitle = title & vbNullChar
        
        If style = "saveas" Then
        
            ' Warn if an existing file is selected.
            .flags = OFN_PATHMUSTEXIST Or OFN_OVERWRITEPROMPT Or OFN_HIDEREADONLY
        
        ElseIf (style = "open" And multiple = False) Then
        
            ' The path and file must exist.
            .flags = OFN_PATHMUSTEXIST Or OFN_FILEMUSTEXIST
        
        ElseIf (style = "open" And multiple = True) Then
        
            ' The path and file must exist and multiple selection is available.
            .flags = OFN_PATHMUSTEXIST Or OFN_FILEMUSTEXIST Or OFN_ALLOWMULTISELECT Or OFN_EXPLORER
        
        End If
        ' The rest of the options aren't needed.
        '.nFileOffset = 0
        '.nFileExtension = 0
        If filter <> "all" Then .lpstrDefExt = filter
        '.lCustData = 0
        '.lpfnHook = 0
        '.lpTemplateName is ignored -- unused string
    End With
    
    ' Display the dialog box.
    If style = "open" Then
    
        Result = GetOpenFileName(filebox)
        
    ElseIf style = "saveas" Then
    
        Result = GetSaveFileName(filebox)
    
    End If
    
    If Result <> 0 Then
       
        If (style = "open" And multiple = True) Then
        
            DialogBox = filebox.lpstrFile
        
        Else
        
            DialogBox = Left(filebox.lpstrFile, InStr(filebox.lpstrFile, vbNullChar) - 1)
        
        End If
        
    End If
    
End Function

use the syntax:

call dialogbox([Title],[Filter],[Style],[DefFile],[InitialDir],[Multiple])

Only the title is compulsory.

Title: Title displayed in title bar for dialog
Filter: File types allowed (default = all, see code for list of types)
Style: Saveas or open (default = open)
DefFile: Ignore but you need the comma as a placeholder
InitialDir: Start directory (default = C:\)
Multiple: Allow multiple selection? (Boolean, default = False)

eg

strFilePath = dialogbox("Hello!",doc,,"P:\Shared\")

would set the value of strFilePath to the value of the file selected, the dialog will open at the P:\Shared directory (with 'Hello!' displayed in the title bar) and the only file types shown would be *.doc.

You'll need to set a reference to the windows scripting runtime library and to the Windows Common Controls (browse to C:\Windows\System32\MSCOMCT2.ocx from the references dialog if you cant see it).

Thank my former colleague who wrote most of this code!

Iain

 

[dazzer123]

Thanks for that, is there no simple way of doing this as you would in say VB .NET where you just add a common dialog control to your form. I'm using Access 2000.

If not i'll use your method, it seems to work ok.

 

[idbr]

Dazzler,

It could be:

There is an activeX control called Windows Common Dialog Control - I can't get it to work as I don't appear to have the licence for it but give it a go!

Iain

 

[PHV]

Doesn't have access 2k an Application.FileDialog property ?

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ222-2244

 

[RoyVidar]

I think the .FileDialog property became available in 2002 (xp), which is probably why there are som much creativity around this in previous versions. Another option, is to reference for instance Excel, and use for instance the GetOpenFilename method.

Roy-Vidar