Windows File Dialog box problem from "Office 2000 VBA Fundamentals
 

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

Windows File Dialog box problem from "Office 2000 VBA Fundamentals
 

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



"Peter Rooney" wrote in
message
...
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

Windows File Dialog box problem from "Office 2000 VBA Fundamen
 

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



"Chip Pearson" wrote:

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



"Peter Rooney" wrote in
message
...
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

Windows File Dialog box problem from "Office 2000 VBA Fundamen
 

I'm not Chip, but I've stolen from him <vbg:

Jim Rech has a BrowseForFolder routine at:
http://www.oaltd.co.uk/MVP/Default.htm
(look for BrowseForFolder)

John Walkenbach has one at:
http://j-walk.com/ss/excel/tips/tip29.htm

If you and all your users are running xl2002+, take a look at VBA's help for:
application.filedialog(msoFileDialogFolderPicker)



Peter Rooney wrote:

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

"Chip Pearson" wrote:

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



"Peter Rooney" wrote in
message
...
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





--

Dave Peterson

Windows File Dialog box problem from "Office 2000 VBA Fundamen
 

Dave,

This was just the job.

Thank you very much! :-)

Have a good weekend.

Pete



"Dave Peterson" wrote:

I'm not Chip, but I've stolen from him <vbg:

Jim Rech has a BrowseForFolder routine at:
http://www.oaltd.co.uk/MVP/Default.htm
(look for BrowseForFolder)

John Walkenbach has one at:
http://j-walk.com/ss/excel/tips/tip29.htm

If you and all your users are running xl2002+, take a look at VBA's help for:
application.filedialog(msoFileDialogFolderPicker)



Peter Rooney wrote:

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

"Chip Pearson" wrote:

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



"Peter Rooney" wrote in
message
...
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





--

Dave Peterson

Windows File Dialog box problem from "Office 2000 VBA Fundamen
 

See http://www.cpearson.com/excel/BrowseFolder.htm .

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


"Peter Rooney" wrote in
message
...
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



"Chip Pearson" wrote:

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



"Peter Rooney" wrote
in
message
...
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

Windows File Dialog box problem from "Office 2000 VBA Fundamen
 

Chip,

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

Regards

Pete



"Chip Pearson" wrote:

See http://www.cpearson.com/excel/BrowseFolder.htm .

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


"Peter Rooney" wrote in
message
...
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



"Chip Pearson" wrote:

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



"Peter Rooney" wrote
in
message
...
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

Windows File Dialog box problem from "Office 2000 VBA Fundamen
 

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



"Chip Pearson" wrote:

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



"Peter Rooney" wrote in
message
...
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

Windows File Dialog box problem from "Office 2000 VBA Fundamen
 

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.



Peter Rooney wrote:

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

"Chip Pearson" wrote:

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



"Peter Rooney" wrote in
message
...
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





--

Dave Peterson

Windows File Dialog box problem from "Office 2000 VBA Fundamen
 

Dave,

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

Thanks

Pete



"Dave Peterson" wrote:

I'm not Chip, but I've stolen from him <vbg:

Jim Rech has a BrowseForFolder routine at:
http://www.oaltd.co.uk/MVP/Default.htm
(look for BrowseForFolder)

John Walkenbach has one at:
http://j-walk.com/ss/excel/tips/tip29.htm

If you and all your users are running xl2002+, take a look at VBA's help for:
application.filedialog(msoFileDialogFolderPicker)



Peter Rooney wrote:

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

"Chip Pearson" wrote:

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



"Peter Rooney" wrote in
message
...
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





--

Dave Peterson

Windows File Dialog box problem from "Office 2000 VBA Fundamen
 

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.

Peter Rooney wrote:

Dave,

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

Thanks

Pete

"Dave Peterson" wrote:

I'm not Chip, but I've stolen from him <vbg:

Jim Rech has a BrowseForFolder routine at:
http://www.oaltd.co.uk/MVP/Default.htm
(look for BrowseForFolder)

John Walkenbach has one at:
http://j-walk.com/ss/excel/tips/tip29.htm

If you and all your users are running xl2002+, take a look at VBA's help for:
application.filedialog(msoFileDialogFolderPicker)



Peter Rooney wrote:

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

"Chip Pearson" wrote:

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



"Peter Rooney" wrote in
message
...
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





--

Dave Peterson


--

Dave Peterson

Windows File Dialog box problem from "Office 2000 VBA Fundamen
 

Dave,

VERY neat. Thanks very much!

Pete



"Dave Peterson" wrote:

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.

Peter Rooney wrote:

Dave,

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

Thanks

Pete

"Dave Peterson" wrote:

I'm not Chip, but I've stolen from him <vbg:

Jim Rech has a BrowseForFolder routine at:
http://www.oaltd.co.uk/MVP/Default.htm
(look for BrowseForFolder)

John Walkenbach has one at:
http://j-walk.com/ss/excel/tips/tip29.htm

If you and all your users are running xl2002+, take a look at VBA's help for:
application.filedialog(msoFileDialogFolderPicker)



Peter Rooney wrote:

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

"Chip Pearson" wrote:

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



"Peter Rooney" wrote in
message
...
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





--

Dave Peterson


--

Dave Peterson