Windows File Dialog box problem from "Office 2000 VBA Fundamentals

P

Peter Rooney

Good 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
 
C

Chip Pearson

I would dispense with the API calls and use Excel's built-in
GetFileOpenFilename method.


Dim FName As Variant
Dim Ndx As Long
FName = Application.GetOpenFilename( _
filefilter:="Excel Files (*.xls),*.xls", MultiSelect:=True)
If IsArray(FName) = True Then
' user selected more than one file
For Ndx = LBound(FName) To UBound(FName)
Debug.Print "User selected:" & FName(Ndx)
Next Ndx
ElseIf FName = False Then
' user didn't select a file
Debug.Print "No file selected."
Else
' user selected one file
Debug.Print "User selected: " & FName
End If



--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting, LLC
www.cpearson.com



message
 
P

Peter Rooney

Hi, Chip,

Sorry about the delay in getting back to you - just survived a blizzard
getting back to work over lunchtime - an we usually don't get too many of
those here!

This works just fine - thank you. Don't suppose you happen to have the
equivalent lying around for selecting a folder, but no file, do you..? :)

Have a good weekend

Pete
 
P

Peter Rooney

Dave,

This was just the job.

Thank you very much! :)

Have a good weekend.

Pete
 
P

Peter Rooney

Chip,

Thanks VERY much - I particularly like the version with the option to create
a new folder :)

Regards

Pete
 
P

Peter Rooney

Chip,

It was only when I tried to modify this code to split the selected filename
down into its component path and filename that I realised that even if you
only select one file, the code logic branches as though you'd selected more
than one i.e. an array. Here, I removed the comments and replaced the
debug.print lines with msgboxes, but otherwise, it's just how you gave it to
me. Try running it and selecting just one file - you branch to the "Array"
msgbox.
Don't suppose you have any thoughts. do you? Is it anything to do with
option base (he asked hopefully... :)

Regards and thanks for your time

Pete

Sub NewVersion()
Dim FName As Variant
Dim Ndx As Long
FName = Application.GetOpenFileName( _
filefilter:="Excel Files (*.xls),*.xls", MultiSelect:=True)
If IsArray(FName) = True Then
For Ndx = LBound(FName) To UBound(FName)
MsgBox ("Array - User selected: " & FName(Ndx))
Next Ndx
ElseIf FName = False Then
MsgBox ("No file selected.")
Else
MsgBox ("Single File - User selected: " & FName)
End If
End Sub
 
D

Dave Peterson

If the user only selects one file, then an array with a single element is
created.

If you want to know how many were selected, you could just subtract:

msgbox ubound(fname) - lbound(fname) + 1

In fact, you could do that calculation and brance accordingly.

If you don't want the user to select more than one file, then don't use
multiselect:=true.
 
P

Peter Rooney

Dave,

Could you post your most recent post again - I received an email
notification, but the posting isn't showing anything..! :)

Thanks

Pete
 
D

Dave Peterson

If the user only selects one file, then an array with a single element is
created.

If you want to know how many were selected, you could just subtract:

msgbox ubound(fname) - lbound(fname) + 1

In fact, you could do that calculation and brance accordingly.

If you don't want the user to select more than one file, then don't use
multiselect:=true.
 
P

Peter Rooney

Dave,

VERY neat. Thanks very much!

Pete



Dave Peterson said:
If the user only selects one file, then an array with a single element is
created.

If you want to know how many were selected, you could just subtract:

msgbox ubound(fname) - lbound(fname) + 1

In fact, you could do that calculation and brance accordingly.

If you don't want the user to select more than one file, then don't use
multiselect:=true.
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Closing PDF file from Excel VBA (Adobe Reader, Adobe Acrobat, Browser) 0
converting VBA password-masking code to 64-bit 0
Alarm 2 2
use vba to open pdf then save as xml 6
Closing programs on remote PC - help please 1
Excel Application to MS Access Application 2
Automatically copy with save? 8
retrun an RGB value to a specified cell 4

Top