Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#10
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#11
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#12
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Office 2000 and Windows 7 Problem | Excel Discussion (Misc queries) | |||
What replaces the Office 2000 add-in "Access Form" in Office 2003 | Excel Discussion (Misc queries) | |||
Can u Import Macintosh 2.1 Excel file into Windows Office 2000? | Excel Discussion (Misc queries) | |||
Excel Programs developed in Office 2000 on Windows 2000 | Excel Discussion (Misc queries) | |||
Office 2000 and Windows XP | Excel Discussion (Misc queries) |