Long time ago while reading Access 97 Developers Handbook,
I came across the solution. The following is a sample code
from one of my databases. Just paste it into a new module,
and run GetOpenFileName function. You may need to change
the Filter and other properties to suit your needs:
' *****************************
Option Compare Database
Option Explicit
Private Declare Function GetExitCodeProcess Lib "kernel32"
(ByVal hProcess As Long, lpExitCode As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal
dwMilliseconds As Long)
Private Declare Function OpenProcess Lib "kernel32" (ByVal
dwDesiredAccess As Long, ByVal bInheritHandle As Long,
ByVal dwProcessId As Long) As Long
Private Declare Function adh_accOfficeGetFileName
Lib "msaccess.exe" _
Alias "#56" (gfni As adh_accOfficeGetFileNameInfo, ByVal
fOpen As Integer) As Long
Public Type adh_accOfficeGetFileNameInfo
hwndOwner As Long
strAppName As String * 255
strDlgTitle As String * 255
strOpenTitle As String * 255
strFile As String * 4096
strInitialDir As String * 255
strFilter As String * 255
lngFilterIndex As Long
lngView As Long
lngFlags As Long
End Type
' GetFileNameInfo flags
Public Const adhcGfniConfirmReplace = &H1 '
Prompt if overwriting a file?
Public Const adhcGfniNoChangeDir = &H2 '
Disable the read-only option
Public Const adhcGfniAllowReadOnly =
&H4 ' Don't change to the directory the
user selected?
Public Const adhcGfniAllowMultiSelect = &H8 '
Allow multiple-selection?
Public Const adhcGfniDirectoryOnly = &H20 '
Open as directory picker?
Public Const adhcGfniInitializeView = &H40 '
Initialize the view to the lView member or use last
selected view?
' General Errors
Public Const adhcAccErrSuccess = 0
Public Const adhcAccErrUnknown = -1
' Dialog Actions
Public Const adhcDialogSave = 0
Public Const adhcDialogOpen = -1
Function adhOfficeGetFileName(gfni As
adh_accOfficeGetFileNameInfo, _
ByVal fOpen As Integer) As Long
' Use the Office file selector common dialog
' exposed by Access.
' From Access 97 Developer's Handbook
' by Litwin, Getz, and Gilbert (Sybex)
' Copyright 1997. All rights reserved.
Dim lng As Long
With gfni
.strAppName = RTrim$(.strAppName) & vbNullChar
.strDlgTitle = RTrim$(.strDlgTitle) & vbNullChar
.strOpenTitle = RTrim$(.strOpenTitle) & vbNullChar
.strFile = RTrim$(.strFile) & vbNullChar
.strInitialDir = RTrim$(.strInitialDir) & vbNullChar
.strFilter = RTrim$(.strFilter) & vbNullChar
SysCmd acSysCmdClearHelpTopic
lng = adh_accOfficeGetFileName(gfni, fOpen)
.strAppName = RTrim$(adhTrimNull(.strAppName))
.strDlgTitle = RTrim$(adhTrimNull(.strDlgTitle))
.strOpenTitle = RTrim$(adhTrimNull(.strOpenTitle))
.strFile = RTrim$(adhTrimNull(.strFile))
.strInitialDir = RTrim$(adhTrimNull(.strInitialDir))
.strFilter = RTrim$(adhTrimNull(.strFilter))
End With
adhOfficeGetFileName = lng
End Function
Function adhTrimNull(strVal As String) As String
' Trim the end of a string, stopping at the first
' null character.
' From Access 97 Developer's Handbook
' by Litwin, Getz, and Gilbert (Sybex)
' Copyright 1997. All rights reserved.
Dim intPos As Integer
intPos = InStr(strVal, vbNullChar)
If intPos > 0 Then
adhTrimNull = Left$(strVal, intPos - 1)
Else
adhTrimNull = strVal
End If
End Function
Public Function GetOpenFileName(Optional ByVal fileName As
String) As String
Dim gfni As adh_accOfficeGetFileNameInfo
With gfni
.lngFlags = adhcGfniConfirmReplace
' Make sure not to pass in Null values.
adhOfficeGetFile
' doesn't like that, and often GPFs.
.strFilter = "Excel (*.xls)|*.xls"
'.lngFilterIndex = 1
.strFile = fileName
.strDlgTitle = "Import file"
.strOpenTitle = "&Import"
'.strInitialDir = ""
End With
If adhOfficeGetFileName(gfni, adhcDialogOpen) =
adhcAccErrSuccess Then
GetOpenFileName = Trim$(gfni.strFile)
End If
End Function
' *****************************
HTH
