How display Windows dialog to get a file destination?

Tech-Archive recommends: Fix windows errors by optimizing your registry

anonymous_at_discussions.microsoft.com
Date: 07/07/04 

Date: Wed, 7 Jul 2004 10:55:43 -0700

A long time ago I found this article from Microsoft that
documented how to call the Open common Dialog box. Copy
this code into a module and call it like this:
varFileName = GetOpenFile(strInitialDir, strTitle)
The variable will give you the path the user seleced then
place the variable in your export line.
-Cameron Sutherland

Option Compare Database
Option Explicit
'**********************************************************
*********************************
'*
'* Use Windows API to call open file common dialog box
'*
'* Created by Microsoft
'*
http://support.microsoft.com/support/kb/articles/Q96/1/14.A
SP?LN=EN-US&SD=gn&FR=0
'*
'**********************************************************
*********************************
'Declarations for Windows Common Dialogs procedures
    Private Type API_OPENFILE
        strFilter As String 'Filter string
        intFilterIndex As Long 'Initial Filter to
display.
        strInitialDir As String 'Initial directory
for the dialog to open in.
        strInitialFile As String 'Initial file name
to populate the dialog with.
        strDialogTitle As String 'Dialog title
        strDefaultExtension As String 'Default extension
to append to file if user didn't specify one.
        lngFlags As Long 'Flags (see
constant list) to be used.
        strFullPathReturned As String 'Full path of file
picked.
        strFileNameReturned As String 'File name of file
picked.
        intFileOffset As Integer 'Offset in full
path (strFullPathReturned) where the file name
(strFileNameReturned) begins.
        intFileExtension As Integer 'Offset in full
path (strFullPathReturned) where the file extension begins.
    End Type
    Const ALLFILES = "All Files"
    Private Type API_WINOPENFILENAME
        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
        flags As Long
        nFileOffset As Integer
        nFileExtension As Integer
        lpstrDefExt As String
        lCustrData As Long
        lpfnHook As Long
        lpTemplateName As String
    End Type
    Const OFN_ALLOWMULTISELECT = &H200
    Const OFN_CREATEPROMPT = &H2000
    Const OFN_EXPLORER = &H80000
    Const OFN_FILEMUSTEXIST = &H1000
    Const OFN_HIDEREADONLY = &H4
    Const OFN_NOCHANGEDIR = &H8
    Const OFN_NODEREFERENCELINKS = &H100000
    Const OFN_NONETWORKBUTTON = &H20000
    Const OFN_NOREADONLYRETURN = &H8000
    Const OFN_NOVALIDATE = &H100
    Const OFN_OVERWRITEPROMPT = &H2
    Const OFN_PATHMUSTEXIST = &H800
    Const OFN_READONLY = &H1
    Const OFN_SHOWHELP = &H10
    Declare Function API_GetOpenFileName
Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename
As API_WINOPENFILENAME) As Boolean
    Declare Function API_GetSaveFileName
Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename
As API_WINOPENFILENAME) As Boolean
    Declare Sub API_ChooseColor Lib "msaccess.exe"
Alias "#53" (ByVal hwnd As Long, rgb As Long)

Public Function GetOpenFile(strInitialDir As String,
strTitle As String) As String
'**********************************************************
*********************************
'* Created by Microsoft
'*
http://support.microsoft.com/support/kb/articles/Q96/1/14.A
SP?LN=EN-US&SD=gn&FR=0
'* This module calls the Windows API GetOpenFileName
Common Dialog Box from the comdlg32.dll.
'* It is used in some forms as the Browse button.
'*
'* In: strInitialDir - path for the initial directory or
blank for the current directory as String
'* strTitle - title for the dialog as String
'* Out: Path, name and extension of the file selected
as String
'* Syntax in a form:
'* varFileName = GetOpenFile(strInitialDir, strTitle)
'*
'**********************************************************
*********************************
    Dim fOK As Boolean
    Dim typWinOpen As API_WINOPENFILENAME
    Dim typOpenFile As API_OPENFILE
    Dim strFilter As String
    On Error GoTo PROC_ERR
'Set reasonable defaults for the structure
    strFilter = CreateFilterString("Database Files
(*.MDB)", "*.MDB", "All Files (*.*)", "*.*")
    If strInitialDir <> "" Then
        typOpenFile.strInitialDir = strInitialDir
    Else
        typOpenFile.strInitialDir = CurDir()
    End If
    If strTitle <> "" Then
        typOpenFile.strDialogTitle = strTitle
    End If
    typOpenFile.strFilter = strFilter
    typOpenFile.lngFlags = OFN_HIDEREADONLY Or OFN_SHOWHELP
'Convert the structure to a Win structure
    Convert2Win typOpenFile, typWinOpen
'Call the Common dialog
    fOK = API_GetOpenFileName(typWinOpen)
'Convert the Win structure back to a structure
    ConvertWin2 typWinOpen, typOpenFile
    GetOpenFile = typOpenFile.strFullPathReturned
PROC_EXIT:
    Exit Function
PROC_ERR:
    GetOpenFile = ""
    Resume PROC_EXIT
    End Function

Public Sub Convert2Win(Struct As API_OPENFILE, Win_Struct
As API_WINOPENFILENAME)
'**********************************************************
*********************************
'* Created by Microsoft
'*
http://support.microsoft.com/support/kb/articles/Q96/1/14.A
SP?LN=EN-US&SD=gn&FR=0
'* Converts the passed API structure to a Windows
structure
'*
'* In: Struct - record of type API_OPENFILE
'* Win_Struct - record of type API_WINOPENFILENAME
'* Out: Nothing
'* Syntax in a form:
'* Called from other module. Do not call this singularly
'*
'**********************************************************
*********************************
    Dim strFile As String * 512
    On Error GoTo PROC_ERR
    Win_Struct.hWndOwner = Application.hWndAccessApp
    Win_Struct.hInstance = 0
    If Struct.strFilter = "" Then
        Win_Struct.lpstrFilter = ALLFILES & Chr$(0)
& "*.*" & Chr$(0)
    Else
        Win_Struct.lpstrFilter = Struct.strFilter
    End If
    Win_Struct.nFilterIndex = Struct.intFilterIndex
    Win_Struct.lpstrFile = String(512, 0)
    Win_Struct.nMaxFile = 511
    Win_Struct.lpstrFileTitle = String$(512, 0)
    Win_Struct.nMaxFileTitle = 511
    Win_Struct.lpstrTitle = Struct.strDialogTitle
    Win_Struct.lpstrInitialDir = Struct.strInitialDir
    Win_Struct.lpstrDefExt = Struct.strDefaultExtension
    Win_Struct.flags = Struct.lngFlags
    Win_Struct.lStructSize = Len(Win_Struct)
PROC_EXIT:
    Exit Sub
PROC_ERR:
    Resume PROC_EXIT
End Sub

Public Sub ConvertWin2(Win_Struct As API_WINOPENFILENAME,
Struct As API_OPENFILE)
'**********************************************************
*********************************
'* Created by Microsoft
'*
http://support.microsoft.com/support/kb/articles/Q96/1/14.A
SP?LN=EN-US&SD=gn&FR=0
'* Converts Windows structure to the passed API
'*
'* In: Win_Struct - record of type API_WINOPENFILENAME
'* Struct - record of type API_OPENFILE
'* Out: Nothing
'* Syntax in a form:
'* Called from other module. Do not call this singularly
'*
'**********************************************************
*********************************
    On Error GoTo PROC_ERR
    Struct.strFullPathReturned = Left
(Win_Struct.lpstrFile, InStr(Win_Struct.lpstrFile,
vbNullChar) - 1)
    Struct.strFileNameReturned = RemoveNulls
(Win_Struct.lpstrFileTitle)
    Struct.intFileOffset = Win_Struct.nFileOffset
    Struct.intFileExtension = Win_Struct.nFileExtension
PROC_EXIT:
    Exit Sub
PROC_ERR:
    Resume PROC_EXIT
End Sub

Public Function CreateFilterString(ParamArray varFilt() As
Variant) As String
'**********************************************************
*********************************
'* Created by Microsoft
'*
http://support.microsoft.com/support/kb/articles/Q96/1/14.A
SP?LN=EN-US&SD=gn&FR=0
'* Builds a Windows formatted filter string for "file
type"
'*
'* In: varFilter - parameter array in the format:
'* Text, Filter, Text, Filter ...
'* Such as:
'* "All Files (*.*)", "*.*", "Text Files
(*.TXT)", "*.TXT"
'* Out: windows formatted filter string
'* Syntax in a form:
'* Called from other module. Do not call this singularly
'*
'**********************************************************
*********************************
    Dim strFilter As String
    Dim intCounter As Long
    Dim intParamCount As Integer
    On Error GoTo PROC_ERR
'Get the count of paramaters passed to the function
    intParamCount = UBound(varFilt)
    If (intParamCount <> -1) Then
        'Count through each parameter
        For intCounter = 0 To intParamCount
            strFilter = strFilter & varFilt(intCounter) &
Chr$(0)
        Next
        'Check for an even number of parameters
        If (intParamCount Mod 2) = 0 Then
            strFilter = strFilter & "*.*" & Chr$(0)
        End If
    End If
    CreateFilterString = strFilter
PROC_EXIT:
    Exit Function
PROC_ERR:
    CreateFilterString = ""
    Resume PROC_EXIT
End Function

Public Function RemoveNulls(strIn As String) As String
'**********************************************************
*********************************
'* Created by Microsoft
'*
http://support.microsoft.com/support/kb/articles/Q96/1/14.A
SP?LN=EN-US&SD=gn&FR=0
'* Removes terminator from a string
'*
'* In: strIn - string to modify
'* Out: modified string
'* Syntax in a form:
'* Called from other module. Do not call this singularly
'*
'**********************************************************
*********************************
    Dim intChr As Integer
    intChr = InStr(strIn, Chr$(0))
    If intChr > 0 Then
        RemoveNulls = Left$(strIn, intChr - 1)
    Else
        RemoveNulls = strIn
    End If
End Function

>-----Original Message-----
>My system has an export function and I'd like to display
the standard Windows dialog box that allows specification
of a destination (like the one that appears when you link
a database). I also need to capture in Access the path
that the user selected.
>Anyone know how?
>.
>

Quantcast