LinkBack URL
About LinkBacksGood morning, all!
I'm, working my way through "Microsdoft Office 200 VBA Fundamentals" Chapter
4, looking at displaying a "File Open" dialog box. The downloaded code works
fine, in terms of returning a value when a filename is selected, except that
when I press "Escape" whilst the box is open, at which point I get "Code
Interruption has been interrupted", at the code marked with a #. Can anyone
suggest what's happening. The equivalent code, to display a "browse for
folder" works fine, and correctly clears the dialog box when escape is
pressed.
--------------------FUNCTION--------------------------
Option Explicit
'-------------------------------------------------
' WinAPI Declarations
'-------------------------------------------------
Private Declare Function GetOpenFileName% _
Lib "COMDLG32" _
Alias "GetOpenFileNameA" ( _
OPENFILENAME As OPENFILENAME _
)
Private Declare Function GetSaveFileName _
Lib "comdlg32.dll" _
Alias "GetSaveFileNameA" ( _
pOPENFILENAME As OPENFILENAME _
) As Long
Private Declare Function GetModuleHandle _
Lib "Kernel32" _
Alias "GetModuleHandleA" ( _
ByVal lpModuleName As String _
) As Long
Private Declare Function GetActiveWindow _
Lib "user32" ( _
) As Long
'-------------------------------------------------
' User-Defined Types
'-------------------------------------------------
Private Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As Long
nMaxCustFilter 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 Long
End Type
Public Type FileDialog
Title As String
CustomFilter As String
DefaultExt As String
InitialDir As String
End Type
'-------------------------------------------------
' Module-level Constants
'-------------------------------------------------
'used for GetOpenFileName API
Const OFN_READONLY = &H1
Const OFN_OVERWRITEPROMPT = &H2
Const OFN_HIDEREADONLY = &H4
Const OFN_NOCHANGEDIR = &H8
Const OFN_SHOWHELP = &H10
Const OFN_ENABLEHOOK = &H20
Const OFN_ENABLETEMPLATE = &H40
Const OFN_ENABLETEMPLATEHANDLE = &H80
Const OFN_NOVALIDATE = &H100
Const OFN_ALLOWMULTISELECT = &H200
Const OFN_EXTENSIONDIFFERENT = &H400
Const OFN_PATHMUSTEXIST = &H800
Const OFN_FILEMUSTEXIST = &H1000
Const OFN_CREATEPROMPT = &H2000
Const OFN_SHAREAWARE = &H4000
Const OFN_NOREADONLYRETURN = &H8000
Const OFN_NOTESTFILECREATE = &H10000
Const OFN_SHAREFALLTHROUGH = 2
Const OFN_SHARENOWARN = 1
Const OFN_SHAREWARN = 0
Function WinFileDialog(typOpenDialog As FileDialog, _
iIndex As Integer) As String
Dim OPENFILENAME As OPENFILENAME
Dim Message$, FileName$, FilesDlgTitle
Dim szCurDir$, iReturn As Integer
Dim pathname As String, sAppName As String
'Allocate string space for the returned strings.
FileName$ = Chr$(0) & Space$(255) & Chr$(0)
FilesDlgTitle = Chr$(0) & Space$(255) & Chr$(0)
'Set up the data structure before you call the GetOpenFileName
With OPENFILENAME
.lStructSize = Len(OPENFILENAME)
.hwndOwner = GetActiveWindow&
.lpstrFilter = typOpenDialog.CustomFilter
.nFilterIndex = 1
.lpstrFile = FileName$
.nMaxFile = Len(FileName$)
.nMaxFileTitle = Len(typOpenDialog.Title)
.lpstrTitle = typOpenDialog.Title
.Flags = OFN_FILEMUSTEXIST Or _
OFN_HIDEREADONLY
.lpstrDefExt = typOpenDialog.DefaultExt
.lpstrInitialDir = typOpenDialog.InitialDir
End With
If iIndex = 1 Then
iReturn = GetOpenFileName(OPENFILENAME)
Else
iReturn = GetSaveFileName(OPENFILENAME)
#######
End If
If iReturn Then
WinFileDialog = Left(OPENFILENAME.lpstrFile,
InStr(OPENFILENAME.lpstrFile, Chr$(0)) - 1)
End If
End Function
--------------------MACRO--------------------------
Sub GetFileWithSystemFileDialog()
Dim sFileName As String
Dim udtFileDialog As FileDialog
With udtFileDialog
'.CustomFilter = "Text Files (*.txt)" & Chr$(0) & "*.txt" & Chr$(0)
& Chr$(0)
.CustomFilter = "All Microsoft Office Excel Files (*.xls)" & Chr$(0)
& "*.xls" & Chr$(0) & Chr$(0)
'.DefaultExt = "*.txt"
.DefaultExt = "*.xls"
.Title = "Browse"
.InitialDir = "C:\"
sFileName = modFileDialog.WinFileDialog(udtFileDialog, 1)
End With
If Len(sFileName) > 0 Then
Debug.Print sFileName
MsgBox (sFileName)
End If
End Sub
Thanks in advance for your assistance.
Pete
Register To Reply
Bookmarks