Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Importing XML with partial file name
I have to select and import files all day long with an XML extension. Two files are imported for each case. The file names are paired with one file ending with "OUT.XML" and its companion file ends with "INI.XML". What I want to do is when the end user gets to the point of selecting the *OUT.XML that it only shows the files ending in *OUT.XML. The code is set up to automatically pick up the INI file. Yet when I get to the point at which the macro displays the list of available files, I see both files - the OUT.XML and the INI.XML. How can I limit the selection to the *OUT.XML". Sub ImportXMLFile() Set wbMain = ThisWorkbook Set wsInputs = wbMain.Worksheets("GUI") Set wsXMLSource = wbMain.Worksheets("XMLSource") Set wsColumnParse = wbMain.Worksheets("ColumnParse") Set wsXMLINI = wbMain.Worksheets("XMLINI") strRelayOutSourceDir = wsInputs.Range("D22") ChDirNet strRelayOutSourceDir strFilter = "XML files (*out.xml), *out.xml" strCaption = "Select an XML File" strSelectedFile = Application.GetOpenFilename(strFilter, , strCaption) Application.DisplayAlerts = False oldStatusBar = Application.DisplayStatusBar Application.DisplayStatusBar = True Application.StatusBar = "Importing OUT.XML file" 'open selected workbook for the XMLSource Workbooks.OpenXML Filename:=strSelectedFile, LoadOption:= _ xlXmlLoadImportToList Set wbXMLSource = ActiveWorkbook Cells.Select 'pick up the values for the XMLSource tab Selection.Copy Application.DisplayAlerts = False wbMain.Activate wsXMLSource.Activate Cells.PasteSpecial xlPasteValues wbXMLSource.Close (False) Set wbXMLSource = Nothing 'now pick up the INI values Application.StatusBar = "Importing INI file" strSelectedFile = Left(strSelectedFile, Len(strSelectedFile) - 7) strSelectedFile = strSelectedFile + "INI.XML" Workbooks.OpenXML Filename:=strSelectedFile, LoadOption:= _ xlXmlLoadImportToList Set wbXMLINI = ActiveWorkbook Cells.Select Selection.Copy wsXMLINI.Activate Cells.PasteSpecial xlPasteValues wbXMLINI.Close (False) Set wsXMLINI = Nothing Application.StatusBar = False Application.DisplayStatusBar = oldStatusBar wsInputs.Activate Range("B3").Select 'close created objects ' Set wsXMLINI = Nothing Set wsColumnParse = Nothing Set wsInputs = Nothing Set wbMain = Nothing End Sub |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Importing XML with partial file name
unfortunately I don't think that its possible to create a filter this way. I'd suggest that you use your own userform for this replace your Application.GetOpenFileName.... by FetchFiles Option Explicit Sub demo() Dim strSelectedFile As String strSelectedFile = Application.GetOpenFilename("*OUT.XML") End Sub Function FetchFiles(sFilter As String) Load UserForm1 UserForm1.FileFilter = sFilter UserForm1.Show FetchFiles = UserForm1.SelectedFile Unload UserForm1 End Function add a userform, userform1. with three controls command button, cmdOpen, caption: Open command button, cmdCancel, caption: Cancel Listbox, listbox1 and this code behind the userform: Option Explicit Public FileFilter As String Public SelectedFile As String Private Sub cmdCancel_Click() SelectedFile = "False" Me.Hide End Sub Private Sub cmdOpen_Click() If ListBox1.ListIndex < -1 Then SelectedFile = ListBox1 Else SelectedFile = "False" End If Me.Hide End Sub Private Sub UserForm_Initialize() Dim sName As String sName = Dir("C:\Users\Patrick.Patrick-PC\Excel/" & FileFilter) Do While sName < "" ListBox1.AddItem sName sName = Dir Loop End Sub "Don Kline" wrote in message ... I have to select and import files all day long with an XML extension. Two files are imported for each case. The file names are paired with one file ending with "OUT.XML" and its companion file ends with "INI.XML". What I want to do is when the end user gets to the point of selecting the *OUT.XML that it only shows the files ending in *OUT.XML. The code is set up to automatically pick up the INI file. Yet when I get to the point at which the macro displays the list of available files, I see both files - the OUT.XML and the INI.XML. How can I limit the selection to the *OUT.XML". Sub ImportXMLFile() Set wbMain = ThisWorkbook Set wsInputs = wbMain.Worksheets("GUI") Set wsXMLSource = wbMain.Worksheets("XMLSource") Set wsColumnParse = wbMain.Worksheets("ColumnParse") Set wsXMLINI = wbMain.Worksheets("XMLINI") strRelayOutSourceDir = wsInputs.Range("D22") ChDirNet strRelayOutSourceDir strFilter = "XML files (*out.xml), *out.xml" strCaption = "Select an XML File" strSelectedFile = Application.GetOpenFilename(strFilter, , strCaption) Application.DisplayAlerts = False oldStatusBar = Application.DisplayStatusBar Application.DisplayStatusBar = True Application.StatusBar = "Importing OUT.XML file" 'open selected workbook for the XMLSource Workbooks.OpenXML Filename:=strSelectedFile, LoadOption:= _ xlXmlLoadImportToList Set wbXMLSource = ActiveWorkbook Cells.Select 'pick up the values for the XMLSource tab Selection.Copy Application.DisplayAlerts = False wbMain.Activate wsXMLSource.Activate Cells.PasteSpecial xlPasteValues wbXMLSource.Close (False) Set wbXMLSource = Nothing 'now pick up the INI values Application.StatusBar = "Importing INI file" strSelectedFile = Left(strSelectedFile, Len(strSelectedFile) - 7) strSelectedFile = strSelectedFile + "INI.XML" Workbooks.OpenXML Filename:=strSelectedFile, LoadOption:= _ xlXmlLoadImportToList Set wbXMLINI = ActiveWorkbook Cells.Select Selection.Copy wsXMLINI.Activate Cells.PasteSpecial xlPasteValues wbXMLINI.Close (False) Set wsXMLINI = Nothing Application.StatusBar = False Application.DisplayStatusBar = oldStatusBar wsInputs.Activate Range("B3").Select 'close created objects ' Set wsXMLINI = Nothing Set wsColumnParse = Nothing Set wsInputs = Nothing Set wbMain = Nothing End Sub |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Importing XML with partial file name
er sName = Dir("C:\Users\Patrick.Patrick-PC\Excel/" & FileFilter) replace by whatever folder you need sName = Dir("C:\path\" & FileFilter) "Patrick Molloy" wrote in message ... unfortunately I don't think that its possible to create a filter this way. I'd suggest that you use your own userform for this replace your Application.GetOpenFileName.... by FetchFiles Option Explicit Sub demo() Dim strSelectedFile As String strSelectedFile = Application.GetOpenFilename("*OUT.XML") End Sub Function FetchFiles(sFilter As String) Load UserForm1 UserForm1.FileFilter = sFilter UserForm1.Show FetchFiles = UserForm1.SelectedFile Unload UserForm1 End Function add a userform, userform1. with three controls command button, cmdOpen, caption: Open command button, cmdCancel, caption: Cancel Listbox, listbox1 and this code behind the userform: Option Explicit Public FileFilter As String Public SelectedFile As String Private Sub cmdCancel_Click() SelectedFile = "False" Me.Hide End Sub Private Sub cmdOpen_Click() If ListBox1.ListIndex < -1 Then SelectedFile = ListBox1 Else SelectedFile = "False" End If Me.Hide End Sub Private Sub UserForm_Initialize() Dim sName As String sName = Dir("C:\Users\Patrick.Patrick-PC\Excel/" & FileFilter) Do While sName < "" ListBox1.AddItem sName sName = Dir Loop End Sub "Don Kline" wrote in message ... I have to select and import files all day long with an XML extension. Two files are imported for each case. The file names are paired with one file ending with "OUT.XML" and its companion file ends with "INI.XML". What I want to do is when the end user gets to the point of selecting the *OUT.XML that it only shows the files ending in *OUT.XML. The code is set up to automatically pick up the INI file. Yet when I get to the point at which the macro displays the list of available files, I see both files - the OUT.XML and the INI.XML. How can I limit the selection to the *OUT.XML". Sub ImportXMLFile() Set wbMain = ThisWorkbook Set wsInputs = wbMain.Worksheets("GUI") Set wsXMLSource = wbMain.Worksheets("XMLSource") Set wsColumnParse = wbMain.Worksheets("ColumnParse") Set wsXMLINI = wbMain.Worksheets("XMLINI") strRelayOutSourceDir = wsInputs.Range("D22") ChDirNet strRelayOutSourceDir strFilter = "XML files (*out.xml), *out.xml" strCaption = "Select an XML File" strSelectedFile = Application.GetOpenFilename(strFilter, , strCaption) Application.DisplayAlerts = False oldStatusBar = Application.DisplayStatusBar Application.DisplayStatusBar = True Application.StatusBar = "Importing OUT.XML file" 'open selected workbook for the XMLSource Workbooks.OpenXML Filename:=strSelectedFile, LoadOption:= _ xlXmlLoadImportToList Set wbXMLSource = ActiveWorkbook Cells.Select 'pick up the values for the XMLSource tab Selection.Copy Application.DisplayAlerts = False wbMain.Activate wsXMLSource.Activate Cells.PasteSpecial xlPasteValues wbXMLSource.Close (False) Set wbXMLSource = Nothing 'now pick up the INI values Application.StatusBar = "Importing INI file" strSelectedFile = Left(strSelectedFile, Len(strSelectedFile) - 7) strSelectedFile = strSelectedFile + "INI.XML" Workbooks.OpenXML Filename:=strSelectedFile, LoadOption:= _ xlXmlLoadImportToList Set wbXMLINI = ActiveWorkbook Cells.Select Selection.Copy wsXMLINI.Activate Cells.PasteSpecial xlPasteValues wbXMLINI.Close (False) Set wsXMLINI = Nothing Application.StatusBar = False Application.DisplayStatusBar = oldStatusBar wsInputs.Activate Range("B3").Select 'close created objects ' Set wsXMLINI = Nothing Set wsColumnParse = Nothing Set wsInputs = Nothing Set wbMain = Nothing End Sub |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Importing XML with partial file name
You need to use the win32 dll. See thie artice http://msdn.microsoft.com/en-us/libr...ffice.10).aspx Here is the start for the code. I don't have time right now to complete the request. If you need more help let me know. I call the name of the function GetOpenFileNameDLL instead of GetOpenFileName so it wouldn't get confused with the VBA function name. Private Type OPENFILENAME lStructSize As Long hwndOwner As Long hInstance As Long lpstrFilter As String lpstrCustomFilter As String 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 String End Type Private Declare Function GetOpenFileNameDLL _ Lib "COMDLG32.DLL" Alias "GetOpenFileNameA" _ (pOpenfilename As OPENFILENAME) As Long Sub test() Dim OFN As OPENFILENAME With OFN .lStructSize = Len(OFN) ' Size of structure. .nMaxFile = 260 ' Size of buffer. ' Create buffer. .lpstrFile = String(.nMaxFile - 1, 0) Ret = GetOpenFileNameDLL(OFN) ' Call function. If Ret < 0 Then ' Non-zero is success. ' Find first null char. n = InStr(.lpstrFile, vbNullChar) ' Return what's before it. MsgBox Left(.lpstrFile, n - 1) End If End With End Sub "Patrick Molloy" wrote: er sName = Dir("C:\Users\Patrick.Patrick-PC\Excel/" & FileFilter) replace by whatever folder you need sName = Dir("C:\path\" & FileFilter) "Patrick Molloy" wrote in message ... unfortunately I don't think that its possible to create a filter this way. I'd suggest that you use your own userform for this replace your Application.GetOpenFileName.... by FetchFiles Option Explicit Sub demo() Dim strSelectedFile As String strSelectedFile = Application.GetOpenFilename("*OUT.XML") End Sub Function FetchFiles(sFilter As String) Load UserForm1 UserForm1.FileFilter = sFilter UserForm1.Show FetchFiles = UserForm1.SelectedFile Unload UserForm1 End Function add a userform, userform1. with three controls command button, cmdOpen, caption: Open command button, cmdCancel, caption: Cancel Listbox, listbox1 and this code behind the userform: Option Explicit Public FileFilter As String Public SelectedFile As String Private Sub cmdCancel_Click() SelectedFile = "False" Me.Hide End Sub Private Sub cmdOpen_Click() If ListBox1.ListIndex < -1 Then SelectedFile = ListBox1 Else SelectedFile = "False" End If Me.Hide End Sub Private Sub UserForm_Initialize() Dim sName As String sName = Dir("C:\Users\Patrick.Patrick-PC\Excel/" & FileFilter) Do While sName < "" ListBox1.AddItem sName sName = Dir Loop End Sub "Don Kline" wrote in message ... I have to select and import files all day long with an XML extension. Two files are imported for each case. The file names are paired with one file ending with "OUT.XML" and its companion file ends with "INI.XML". What I want to do is when the end user gets to the point of selecting the *OUT.XML that it only shows the files ending in *OUT.XML. The code is set up to automatically pick up the INI file. Yet when I get to the point at which the macro displays the list of available files, I see both files - the OUT.XML and the INI.XML. How can I limit the selection to the *OUT.XML". Sub ImportXMLFile() Set wbMain = ThisWorkbook Set wsInputs = wbMain.Worksheets("GUI") Set wsXMLSource = wbMain.Worksheets("XMLSource") Set wsColumnParse = wbMain.Worksheets("ColumnParse") Set wsXMLINI = wbMain.Worksheets("XMLINI") strRelayOutSourceDir = wsInputs.Range("D22") ChDirNet strRelayOutSourceDir strFilter = "XML files (*out.xml), *out.xml" strCaption = "Select an XML File" strSelectedFile = Application.GetOpenFilename(strFilter, , strCaption) Application.DisplayAlerts = False oldStatusBar = Application.DisplayStatusBar Application.DisplayStatusBar = True Application.StatusBar = "Importing OUT.XML file" 'open selected workbook for the XMLSource Workbooks.OpenXML Filename:=strSelectedFile, LoadOption:= _ xlXmlLoadImportToList Set wbXMLSource = ActiveWorkbook Cells.Select 'pick up the values for the XMLSource tab Selection.Copy Application.DisplayAlerts = False wbMain.Activate wsXMLSource.Activate Cells.PasteSpecial xlPasteValues wbXMLSource.Close (False) Set wbXMLSource = Nothing 'now pick up the INI values Application.StatusBar = "Importing INI file" strSelectedFile = Left(strSelectedFile, Len(strSelectedFile) - 7) strSelectedFile = strSelectedFile + "INI.XML" Workbooks.OpenXML Filename:=strSelectedFile, LoadOption:= _ xlXmlLoadImportToList Set wbXMLINI = ActiveWorkbook Cells.Select Selection.Copy wsXMLINI.Activate Cells.PasteSpecial xlPasteValues wbXMLINI.Close (False) Set wsXMLINI = Nothing Application.StatusBar = False Application.DisplayStatusBar = oldStatusBar wsInputs.Activate Range("B3").Select 'close created objects ' Set wsXMLINI = Nothing Set wsColumnParse = Nothing Set wsInputs = Nothing Set wbMain = Nothing End Sub |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Importing XML with partial file name
The code below will work. With the DLL you seperate the two parts of the filter with a NULL character (chr(0)). Private Type OPENFILENAME lStructSize As Long hwndOwner As Long hInstance As Long lpstrFilter As String lpstrCustomFilter As String 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 String End Type Private Declare Function GetOpenFileNameDLL _ Lib "COMDLG32.DLL" Alias "GetOpenFileNameA" _ (pOpenfilename As OPENFILENAME) As Long Sub test() strFilter = "XML files (*out.xml)" & Chr(0) & "*out.xml" 'strFilter = "*.xml" Dim OFN As OPENFILENAME OFN.lpstrFilter = strFilter With OFN .lStructSize = Len(OFN) ' Size of structure. .nMaxFile = 260 ' Size of buffer. ' Create buffer. .lpstrFile = String(.nMaxFile - 1, 0) Ret = GetOpenFileNameDLL(OFN) ' Call function. If Ret < 0 Then ' Non-zero is success. ' Find first null char. n = InStr(.lpstrFile, vbNullChar) ' Return what's before it. MsgBox Left(.lpstrFile, n - 1) End If End With End Sub "Joel" wrote: You need to use the win32 dll. See thie artice http://msdn.microsoft.com/en-us/libr...ffice.10).aspx Here is the start for the code. I don't have time right now to complete the request. If you need more help let me know. I call the name of the function GetOpenFileNameDLL instead of GetOpenFileName so it wouldn't get confused with the VBA function name. Private Type OPENFILENAME lStructSize As Long hwndOwner As Long hInstance As Long lpstrFilter As String lpstrCustomFilter As String 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 String End Type Private Declare Function GetOpenFileNameDLL _ Lib "COMDLG32.DLL" Alias "GetOpenFileNameA" _ (pOpenfilename As OPENFILENAME) As Long Sub test() Dim OFN As OPENFILENAME With OFN .lStructSize = Len(OFN) ' Size of structure. .nMaxFile = 260 ' Size of buffer. ' Create buffer. .lpstrFile = String(.nMaxFile - 1, 0) Ret = GetOpenFileNameDLL(OFN) ' Call function. If Ret < 0 Then ' Non-zero is success. ' Find first null char. n = InStr(.lpstrFile, vbNullChar) ' Return what's before it. MsgBox Left(.lpstrFile, n - 1) End If End With End Sub "Patrick Molloy" wrote: er sName = Dir("C:\Users\Patrick.Patrick-PC\Excel/" & FileFilter) replace by whatever folder you need sName = Dir("C:\path\" & FileFilter) "Patrick Molloy" wrote in message ... unfortunately I don't think that its possible to create a filter this way. I'd suggest that you use your own userform for this replace your Application.GetOpenFileName.... by FetchFiles Option Explicit Sub demo() Dim strSelectedFile As String strSelectedFile = Application.GetOpenFilename("*OUT.XML") End Sub Function FetchFiles(sFilter As String) Load UserForm1 UserForm1.FileFilter = sFilter UserForm1.Show FetchFiles = UserForm1.SelectedFile Unload UserForm1 End Function add a userform, userform1. with three controls command button, cmdOpen, caption: Open command button, cmdCancel, caption: Cancel Listbox, listbox1 and this code behind the userform: Option Explicit Public FileFilter As String Public SelectedFile As String Private Sub cmdCancel_Click() SelectedFile = "False" Me.Hide End Sub Private Sub cmdOpen_Click() If ListBox1.ListIndex < -1 Then SelectedFile = ListBox1 Else SelectedFile = "False" End If Me.Hide End Sub Private Sub UserForm_Initialize() Dim sName As String sName = Dir("C:\Users\Patrick.Patrick-PC\Excel/" & FileFilter) Do While sName < "" ListBox1.AddItem sName sName = Dir Loop End Sub "Don Kline" wrote in message ... I have to select and import files all day long with an XML extension. Two files are imported for each case. The file names are paired with one file ending with "OUT.XML" and its companion file ends with "INI.XML". What I want to do is when the end user gets to the point of selecting the *OUT.XML that it only shows the files ending in *OUT.XML. The code is set up to automatically pick up the INI file. Yet when I get to the point at which the macro displays the list of available files, I see both files - the OUT.XML and the INI.XML. How can I limit the selection to the *OUT.XML". Sub ImportXMLFile() Set wbMain = ThisWorkbook Set wsInputs = wbMain.Worksheets("GUI") Set wsXMLSource = wbMain.Worksheets("XMLSource") Set wsColumnParse = wbMain.Worksheets("ColumnParse") Set wsXMLINI = wbMain.Worksheets("XMLINI") strRelayOutSourceDir = wsInputs.Range("D22") ChDirNet strRelayOutSourceDir strFilter = "XML files (*out.xml), *out.xml" strCaption = "Select an XML File" strSelectedFile = Application.GetOpenFilename(strFilter, , strCaption) Application.DisplayAlerts = False oldStatusBar = Application.DisplayStatusBar Application.DisplayStatusBar = True Application.StatusBar = "Importing OUT.XML file" 'open selected workbook for the XMLSource Workbooks.OpenXML Filename:=strSelectedFile, LoadOption:= _ xlXmlLoadImportToList Set wbXMLSource = ActiveWorkbook Cells.Select 'pick up the values for the XMLSource tab Selection.Copy Application.DisplayAlerts = False wbMain.Activate wsXMLSource.Activate Cells.PasteSpecial xlPasteValues wbXMLSource.Close (False) Set wbXMLSource = Nothing 'now pick up the INI values Application.StatusBar = "Importing INI file" strSelectedFile = Left(strSelectedFile, Len(strSelectedFile) - 7) strSelectedFile = strSelectedFile + "INI.XML" Workbooks.OpenXML Filename:=strSelectedFile, LoadOption:= _ xlXmlLoadImportToList Set wbXMLINI = ActiveWorkbook Cells.Select Selection.Copy wsXMLINI.Activate Cells.PasteSpecial xlPasteValues wbXMLINI.Close (False) Set wsXMLINI = Nothing Application.StatusBar = False Application.DisplayStatusBar = oldStatusBar wsInputs.Activate Range("B3").Select 'close created objects ' Set wsXMLINI = Nothing Set wsColumnParse = Nothing Set wsInputs = Nothing Set wbMain = Nothing End Sub |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Importing XML with partial file name
I'm running in Excel 2003. May I assume that I would have the requisite DLL? "Joel" wrote: The code below will work. With the DLL you seperate the two parts of the filter with a NULL character (chr(0)). Private Type OPENFILENAME lStructSize As Long hwndOwner As Long hInstance As Long lpstrFilter As String lpstrCustomFilter As String 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 String End Type Private Declare Function GetOpenFileNameDLL _ Lib "COMDLG32.DLL" Alias "GetOpenFileNameA" _ (pOpenfilename As OPENFILENAME) As Long Sub test() strFilter = "XML files (*out.xml)" & Chr(0) & "*out.xml" 'strFilter = "*.xml" Dim OFN As OPENFILENAME OFN.lpstrFilter = strFilter With OFN .lStructSize = Len(OFN) ' Size of structure. .nMaxFile = 260 ' Size of buffer. ' Create buffer. .lpstrFile = String(.nMaxFile - 1, 0) Ret = GetOpenFileNameDLL(OFN) ' Call function. If Ret < 0 Then ' Non-zero is success. ' Find first null char. n = InStr(.lpstrFile, vbNullChar) ' Return what's before it. MsgBox Left(.lpstrFile, n - 1) End If End With End Sub "Joel" wrote: You need to use the win32 dll. See thie artice http://msdn.microsoft.com/en-us/libr...ffice.10).aspx Here is the start for the code. I don't have time right now to complete the request. If you need more help let me know. I call the name of the function GetOpenFileNameDLL instead of GetOpenFileName so it wouldn't get confused with the VBA function name. Private Type OPENFILENAME lStructSize As Long hwndOwner As Long hInstance As Long lpstrFilter As String lpstrCustomFilter As String 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 String End Type Private Declare Function GetOpenFileNameDLL _ Lib "COMDLG32.DLL" Alias "GetOpenFileNameA" _ (pOpenfilename As OPENFILENAME) As Long Sub test() Dim OFN As OPENFILENAME With OFN .lStructSize = Len(OFN) ' Size of structure. .nMaxFile = 260 ' Size of buffer. ' Create buffer. .lpstrFile = String(.nMaxFile - 1, 0) Ret = GetOpenFileNameDLL(OFN) ' Call function. If Ret < 0 Then ' Non-zero is success. ' Find first null char. n = InStr(.lpstrFile, vbNullChar) ' Return what's before it. MsgBox Left(.lpstrFile, n - 1) End If End With End Sub "Patrick Molloy" wrote: er sName = Dir("C:\Users\Patrick.Patrick-PC\Excel/" & FileFilter) replace by whatever folder you need sName = Dir("C:\path\" & FileFilter) "Patrick Molloy" wrote in message ... unfortunately I don't think that its possible to create a filter this way. I'd suggest that you use your own userform for this replace your Application.GetOpenFileName.... by FetchFiles Option Explicit Sub demo() Dim strSelectedFile As String strSelectedFile = Application.GetOpenFilename("*OUT.XML") End Sub Function FetchFiles(sFilter As String) Load UserForm1 UserForm1.FileFilter = sFilter UserForm1.Show FetchFiles = UserForm1.SelectedFile Unload UserForm1 End Function add a userform, userform1. with three controls command button, cmdOpen, caption: Open command button, cmdCancel, caption: Cancel Listbox, listbox1 and this code behind the userform: Option Explicit Public FileFilter As String Public SelectedFile As String Private Sub cmdCancel_Click() SelectedFile = "False" Me.Hide End Sub Private Sub cmdOpen_Click() If ListBox1.ListIndex < -1 Then SelectedFile = ListBox1 Else SelectedFile = "False" End If Me.Hide End Sub Private Sub UserForm_Initialize() Dim sName As String sName = Dir("C:\Users\Patrick.Patrick-PC\Excel/" & FileFilter) Do While sName < "" ListBox1.AddItem sName sName = Dir Loop End Sub "Don Kline" wrote in message ... I have to select and import files all day long with an XML extension. Two files are imported for each case. The file names are paired with one file ending with "OUT.XML" and its companion file ends with "INI.XML". What I want to do is when the end user gets to the point of selecting the *OUT.XML that it only shows the files ending in *OUT.XML. The code is set up to automatically pick up the INI file. Yet when I get to the point at which the macro displays the list of available files, I see both files - the OUT.XML and the INI.XML. How can I limit the selection to the *OUT.XML". Sub ImportXMLFile() Set wbMain = ThisWorkbook Set wsInputs = wbMain.Worksheets("GUI") Set wsXMLSource = wbMain.Worksheets("XMLSource") Set wsColumnParse = wbMain.Worksheets("ColumnParse") Set wsXMLINI = wbMain.Worksheets("XMLINI") strRelayOutSourceDir = wsInputs.Range("D22") ChDirNet strRelayOutSourceDir strFilter = "XML files (*out.xml), *out.xml" strCaption = "Select an XML File" strSelectedFile = Application.GetOpenFilename(strFilter, , strCaption) Application.DisplayAlerts = False oldStatusBar = Application.DisplayStatusBar Application.DisplayStatusBar = True Application.StatusBar = "Importing OUT.XML file" 'open selected workbook for the XMLSource Workbooks.OpenXML Filename:=strSelectedFile, LoadOption:= _ xlXmlLoadImportToList Set wbXMLSource = ActiveWorkbook Cells.Select 'pick up the values for the XMLSource tab Selection.Copy Application.DisplayAlerts = False wbMain.Activate wsXMLSource.Activate Cells.PasteSpecial xlPasteValues wbXMLSource.Close (False) Set wbXMLSource = Nothing 'now pick up the INI values Application.StatusBar = "Importing INI file" strSelectedFile = Left(strSelectedFile, Len(strSelectedFile) - 7) strSelectedFile = strSelectedFile + "INI.XML" Workbooks.OpenXML Filename:=strSelectedFile, LoadOption:= _ xlXmlLoadImportToList Set wbXMLINI = ActiveWorkbook Cells.Select Selection.Copy wsXMLINI.Activate Cells.PasteSpecial xlPasteValues wbXMLINI.Close (False) Set wsXMLINI = Nothing Application.StatusBar = False Application.DisplayStatusBar = oldStatusBar wsInputs.Activate Range("B3").Select 'close created objects ' Set wsXMLINI = Nothing Set wsColumnParse = Nothing Set wsInputs = Nothing Set wbMain = Nothing End Sub |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
Importing XML with partial file name
Sorry - I keep getting shanghaied into meetings. I have not yet had the time to get this working. "Patrick Molloy" wrote: er sName = Dir("C:\Users\Patrick.Patrick-PC\Excel/" & FileFilter) replace by whatever folder you need sName = Dir("C:\path\" & FileFilter) "Patrick Molloy" wrote in message ... unfortunately I don't think that its possible to create a filter this way. I'd suggest that you use your own userform for this replace your Application.GetOpenFileName.... by FetchFiles Option Explicit Sub demo() Dim strSelectedFile As String strSelectedFile = Application.GetOpenFilename("*OUT.XML") End Sub Function FetchFiles(sFilter As String) Load UserForm1 UserForm1.FileFilter = sFilter UserForm1.Show FetchFiles = UserForm1.SelectedFile Unload UserForm1 End Function add a userform, userform1. with three controls command button, cmdOpen, caption: Open command button, cmdCancel, caption: Cancel Listbox, listbox1 and this code behind the userform: Option Explicit Public FileFilter As String Public SelectedFile As String Private Sub cmdCancel_Click() SelectedFile = "False" Me.Hide End Sub Private Sub cmdOpen_Click() If ListBox1.ListIndex < -1 Then SelectedFile = ListBox1 Else SelectedFile = "False" End If Me.Hide End Sub Private Sub UserForm_Initialize() Dim sName As String sName = Dir("C:\Users\Patrick.Patrick-PC\Excel/" & FileFilter) Do While sName < "" ListBox1.AddItem sName sName = Dir Loop End Sub "Don Kline" wrote in message ... I have to select and import files all day long with an XML extension. Two files are imported for each case. The file names are paired with one file ending with "OUT.XML" and its companion file ends with "INI.XML". What I want to do is when the end user gets to the point of selecting the *OUT.XML that it only shows the files ending in *OUT.XML. The code is set up to automatically pick up the INI file. Yet when I get to the point at which the macro displays the list of available files, I see both files - the OUT.XML and the INI.XML. How can I limit the selection to the *OUT.XML". Sub ImportXMLFile() Set wbMain = ThisWorkbook Set wsInputs = wbMain.Worksheets("GUI") Set wsXMLSource = wbMain.Worksheets("XMLSource") Set wsColumnParse = wbMain.Worksheets("ColumnParse") Set wsXMLINI = wbMain.Worksheets("XMLINI") strRelayOutSourceDir = wsInputs.Range("D22") ChDirNet strRelayOutSourceDir strFilter = "XML files (*out.xml), *out.xml" strCaption = "Select an XML File" strSelectedFile = Application.GetOpenFilename(strFilter, , strCaption) Application.DisplayAlerts = False oldStatusBar = Application.DisplayStatusBar Application.DisplayStatusBar = True Application.StatusBar = "Importing OUT.XML file" 'open selected workbook for the XMLSource Workbooks.OpenXML Filename:=strSelectedFile, LoadOption:= _ xlXmlLoadImportToList Set wbXMLSource = ActiveWorkbook Cells.Select 'pick up the values for the XMLSource tab Selection.Copy Application.DisplayAlerts = False wbMain.Activate wsXMLSource.Activate Cells.PasteSpecial xlPasteValues wbXMLSource.Close (False) Set wbXMLSource = Nothing 'now pick up the INI values Application.StatusBar = "Importing INI file" strSelectedFile = Left(strSelectedFile, Len(strSelectedFile) - 7) strSelectedFile = strSelectedFile + "INI.XML" Workbooks.OpenXML Filename:=strSelectedFile, LoadOption:= _ xlXmlLoadImportToList Set wbXMLINI = ActiveWorkbook Cells.Select Selection.Copy wsXMLINI.Activate Cells.PasteSpecial xlPasteValues wbXMLINI.Close (False) Set wsXMLINI = Nothing Application.StatusBar = False Application.DisplayStatusBar = oldStatusBar wsInputs.Activate Range("B3").Select 'close created objects ' Set wsXMLINI = Nothing Set wsColumnParse = Nothing Set wsInputs = Nothing Set wbMain = Nothing End Sub |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
Importing XML with partial file name
I'm running it also under excel 2003. The microsoft website says some windows releases didn't include COMDLG32.DLL in the windows\system32 folder. If your system doesn't have the file simply copy the file from a PC that has the DLL. All DLL's can be used in VBA code as long as you properly define the DLL properly with the correct entry point. Since a DLL has many entry point the entry point is usually the calling name with the letter A (GetOpenFileNameA) at the end. In some cases different operating systems such as Vista and XP may have different entry points so there may be a B, C, D entry points. "Don Kline" wrote: I'm running in Excel 2003. May I assume that I would have the requisite DLL? "Joel" wrote: The code below will work. With the DLL you seperate the two parts of the filter with a NULL character (chr(0)). Private Type OPENFILENAME lStructSize As Long hwndOwner As Long hInstance As Long lpstrFilter As String lpstrCustomFilter As String 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 String End Type Private Declare Function GetOpenFileNameDLL _ Lib "COMDLG32.DLL" Alias "GetOpenFileNameA" _ (pOpenfilename As OPENFILENAME) As Long Sub test() strFilter = "XML files (*out.xml)" & Chr(0) & "*out.xml" 'strFilter = "*.xml" Dim OFN As OPENFILENAME OFN.lpstrFilter = strFilter With OFN .lStructSize = Len(OFN) ' Size of structure. .nMaxFile = 260 ' Size of buffer. ' Create buffer. .lpstrFile = String(.nMaxFile - 1, 0) Ret = GetOpenFileNameDLL(OFN) ' Call function. If Ret < 0 Then ' Non-zero is success. ' Find first null char. n = InStr(.lpstrFile, vbNullChar) ' Return what's before it. MsgBox Left(.lpstrFile, n - 1) End If End With End Sub "Joel" wrote: You need to use the win32 dll. See thie artice http://msdn.microsoft.com/en-us/libr...ffice.10).aspx Here is the start for the code. I don't have time right now to complete the request. If you need more help let me know. I call the name of the function GetOpenFileNameDLL instead of GetOpenFileName so it wouldn't get confused with the VBA function name. Private Type OPENFILENAME lStructSize As Long hwndOwner As Long hInstance As Long lpstrFilter As String lpstrCustomFilter As String 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 String End Type Private Declare Function GetOpenFileNameDLL _ Lib "COMDLG32.DLL" Alias "GetOpenFileNameA" _ (pOpenfilename As OPENFILENAME) As Long Sub test() Dim OFN As OPENFILENAME With OFN .lStructSize = Len(OFN) ' Size of structure. .nMaxFile = 260 ' Size of buffer. ' Create buffer. .lpstrFile = String(.nMaxFile - 1, 0) Ret = GetOpenFileNameDLL(OFN) ' Call function. If Ret < 0 Then ' Non-zero is success. ' Find first null char. n = InStr(.lpstrFile, vbNullChar) ' Return what's before it. MsgBox Left(.lpstrFile, n - 1) End If End With End Sub "Patrick Molloy" wrote: er sName = Dir("C:\Users\Patrick.Patrick-PC\Excel/" & FileFilter) replace by whatever folder you need sName = Dir("C:\path\" & FileFilter) "Patrick Molloy" wrote in message ... unfortunately I don't think that its possible to create a filter this way. I'd suggest that you use your own userform for this replace your Application.GetOpenFileName.... by FetchFiles Option Explicit Sub demo() Dim strSelectedFile As String strSelectedFile = Application.GetOpenFilename("*OUT.XML") End Sub Function FetchFiles(sFilter As String) Load UserForm1 UserForm1.FileFilter = sFilter UserForm1.Show FetchFiles = UserForm1.SelectedFile Unload UserForm1 End Function add a userform, userform1. with three controls command button, cmdOpen, caption: Open command button, cmdCancel, caption: Cancel Listbox, listbox1 and this code behind the userform: Option Explicit Public FileFilter As String Public SelectedFile As String Private Sub cmdCancel_Click() SelectedFile = "False" Me.Hide End Sub Private Sub cmdOpen_Click() If ListBox1.ListIndex < -1 Then SelectedFile = ListBox1 Else SelectedFile = "False" End If Me.Hide End Sub Private Sub UserForm_Initialize() Dim sName As String sName = Dir("C:\Users\Patrick.Patrick-PC\Excel/" & FileFilter) Do While sName < "" ListBox1.AddItem sName sName = Dir Loop End Sub "Don Kline" wrote in message ... I have to select and import files all day long with an XML extension. Two files are imported for each case. The file names are paired with one file ending with "OUT.XML" and its companion file ends with "INI.XML". What I want to do is when the end user gets to the point of selecting the *OUT.XML that it only shows the files ending in *OUT.XML. The code is set up to automatically pick up the INI file. Yet when I get to the point at which the macro displays the list of available files, I see both files - the OUT.XML and the INI.XML. How can I limit the selection to the *OUT.XML". Sub ImportXMLFile() Set wbMain = ThisWorkbook Set wsInputs = wbMain.Worksheets("GUI") Set wsXMLSource = wbMain.Worksheets("XMLSource") Set wsColumnParse = wbMain.Worksheets("ColumnParse") Set wsXMLINI = wbMain.Worksheets("XMLINI") strRelayOutSourceDir = wsInputs.Range("D22") ChDirNet strRelayOutSourceDir strFilter = "XML files (*out.xml), *out.xml" strCaption = "Select an XML File" strSelectedFile = Application.GetOpenFilename(strFilter, , strCaption) Application.DisplayAlerts = False oldStatusBar = Application.DisplayStatusBar Application.DisplayStatusBar = True Application.StatusBar = "Importing OUT.XML file" 'open selected workbook for the XMLSource Workbooks.OpenXML Filename:=strSelectedFile, LoadOption:= _ xlXmlLoadImportToList Set wbXMLSource = ActiveWorkbook Cells.Select 'pick up the values for the XMLSource tab Selection.Copy Application.DisplayAlerts = False wbMain.Activate wsXMLSource.Activate Cells.PasteSpecial xlPasteValues wbXMLSource.Close (False) Set wbXMLSource = Nothing 'now pick up the INI values Application.StatusBar = "Importing INI file" strSelectedFile = Left(strSelectedFile, Len(strSelectedFile) - 7) strSelectedFile = strSelectedFile + "INI.XML" Workbooks.OpenXML Filename:=strSelectedFile, LoadOption:= _ xlXmlLoadImportToList Set wbXMLINI = ActiveWorkbook Cells.Select Selection.Copy wsXMLINI.Activate Cells.PasteSpecial xlPasteValues wbXMLINI.Close (False) Set wsXMLINI = Nothing Application.StatusBar = False Application.DisplayStatusBar = oldStatusBar wsInputs.Activate Range("B3").Select 'close created objects ' Set wsXMLINI = Nothing Set wsColumnParse = Nothing Set wsInputs = Nothing Set wbMain = Nothing End Sub |
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
Importing XML with partial file name
I just did a search and I do have the COMDLG#@.DLL "Joel" wrote: I'm running it also under excel 2003. The microsoft website says some windows releases didn't include COMDLG32.DLL in the windows\system32 folder. If your system doesn't have the file simply copy the file from a PC that has the DLL. All DLL's can be used in VBA code as long as you properly define the DLL properly with the correct entry point. Since a DLL has many entry point the entry point is usually the calling name with the letter A (GetOpenFileNameA) at the end. In some cases different operating systems such as Vista and XP may have different entry points so there may be a B, C, D entry points. "Don Kline" wrote: I'm running in Excel 2003. May I assume that I would have the requisite DLL? "Joel" wrote: The code below will work. With the DLL you seperate the two parts of the filter with a NULL character (chr(0)). Private Type OPENFILENAME lStructSize As Long hwndOwner As Long hInstance As Long lpstrFilter As String lpstrCustomFilter As String 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 String End Type Private Declare Function GetOpenFileNameDLL _ Lib "COMDLG32.DLL" Alias "GetOpenFileNameA" _ (pOpenfilename As OPENFILENAME) As Long Sub test() strFilter = "XML files (*out.xml)" & Chr(0) & "*out.xml" 'strFilter = "*.xml" Dim OFN As OPENFILENAME OFN.lpstrFilter = strFilter With OFN .lStructSize = Len(OFN) ' Size of structure. .nMaxFile = 260 ' Size of buffer. ' Create buffer. .lpstrFile = String(.nMaxFile - 1, 0) Ret = GetOpenFileNameDLL(OFN) ' Call function. If Ret < 0 Then ' Non-zero is success. ' Find first null char. n = InStr(.lpstrFile, vbNullChar) ' Return what's before it. MsgBox Left(.lpstrFile, n - 1) End If End With End Sub "Joel" wrote: You need to use the win32 dll. See thie artice http://msdn.microsoft.com/en-us/libr...ffice.10).aspx Here is the start for the code. I don't have time right now to complete the request. If you need more help let me know. I call the name of the function GetOpenFileNameDLL instead of GetOpenFileName so it wouldn't get confused with the VBA function name. Private Type OPENFILENAME lStructSize As Long hwndOwner As Long hInstance As Long lpstrFilter As String lpstrCustomFilter As String 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 String End Type Private Declare Function GetOpenFileNameDLL _ Lib "COMDLG32.DLL" Alias "GetOpenFileNameA" _ (pOpenfilename As OPENFILENAME) As Long Sub test() Dim OFN As OPENFILENAME With OFN .lStructSize = Len(OFN) ' Size of structure. .nMaxFile = 260 ' Size of buffer. ' Create buffer. .lpstrFile = String(.nMaxFile - 1, 0) Ret = GetOpenFileNameDLL(OFN) ' Call function. If Ret < 0 Then ' Non-zero is success. ' Find first null char. n = InStr(.lpstrFile, vbNullChar) ' Return what's before it. MsgBox Left(.lpstrFile, n - 1) End If End With End Sub "Patrick Molloy" wrote: er sName = Dir("C:\Users\Patrick.Patrick-PC\Excel/" & FileFilter) replace by whatever folder you need sName = Dir("C:\path\" & FileFilter) "Patrick Molloy" wrote in message ... unfortunately I don't think that its possible to create a filter this way. I'd suggest that you use your own userform for this replace your Application.GetOpenFileName.... by FetchFiles Option Explicit Sub demo() Dim strSelectedFile As String strSelectedFile = Application.GetOpenFilename("*OUT.XML") End Sub Function FetchFiles(sFilter As String) Load UserForm1 UserForm1.FileFilter = sFilter UserForm1.Show FetchFiles = UserForm1.SelectedFile Unload UserForm1 End Function add a userform, userform1. with three controls command button, cmdOpen, caption: Open command button, cmdCancel, caption: Cancel Listbox, listbox1 and this code behind the userform: Option Explicit Public FileFilter As String Public SelectedFile As String Private Sub cmdCancel_Click() SelectedFile = "False" Me.Hide End Sub Private Sub cmdOpen_Click() If ListBox1.ListIndex < -1 Then SelectedFile = ListBox1 Else SelectedFile = "False" End If Me.Hide End Sub Private Sub UserForm_Initialize() Dim sName As String sName = Dir("C:\Users\Patrick.Patrick-PC\Excel/" & FileFilter) Do While sName < "" ListBox1.AddItem sName sName = Dir Loop End Sub "Don Kline" wrote in message ... I have to select and import files all day long with an XML extension. Two files are imported for each case. The file names are paired with one file ending with "OUT.XML" and its companion file ends with "INI.XML". What I want to do is when the end user gets to the point of selecting the *OUT.XML that it only shows the files ending in *OUT.XML. The code is set up to automatically pick up the INI file. Yet when I get to the point at which the macro displays the list of available files, I see both files - the OUT.XML and the INI.XML. How can I limit the selection to the *OUT.XML". Sub ImportXMLFile() Set wbMain = ThisWorkbook Set wsInputs = wbMain.Worksheets("GUI") Set wsXMLSource = wbMain.Worksheets("XMLSource") Set wsColumnParse = wbMain.Worksheets("ColumnParse") Set wsXMLINI = wbMain.Worksheets("XMLINI") strRelayOutSourceDir = wsInputs.Range("D22") ChDirNet strRelayOutSourceDir strFilter = "XML files (*out.xml), *out.xml" strCaption = "Select an XML File" strSelectedFile = Application.GetOpenFilename(strFilter, , strCaption) Application.DisplayAlerts = False oldStatusBar = Application.DisplayStatusBar Application.DisplayStatusBar = True Application.StatusBar = "Importing OUT.XML file" 'open selected workbook for the XMLSource Workbooks.OpenXML Filename:=strSelectedFile, LoadOption:= _ xlXmlLoadImportToList Set wbXMLSource = ActiveWorkbook Cells.Select 'pick up the values for the XMLSource tab Selection.Copy Application.DisplayAlerts = False wbMain.Activate wsXMLSource.Activate Cells.PasteSpecial xlPasteValues wbXMLSource.Close (False) Set wbXMLSource = Nothing 'now pick up the INI values Application.StatusBar = "Importing INI file" strSelectedFile = Left(strSelectedFile, Len(strSelectedFile) - 7) strSelectedFile = strSelectedFile + "INI.XML" Workbooks.OpenXML Filename:=strSelectedFile, LoadOption:= _ xlXmlLoadImportToList Set wbXMLINI = ActiveWorkbook Cells.Select Selection.Copy wsXMLINI.Activate Cells.PasteSpecial xlPasteValues wbXMLINI.Close (False) Set wsXMLINI = Nothing Application.StatusBar = False Application.DisplayStatusBar = oldStatusBar wsInputs.Activate Range("B3").Select 'close created objects ' Set wsXMLINI = Nothing Set wsColumnParse = Nothing Set wsInputs = Nothing Set wbMain = Nothing End Sub |
#10
Posted to microsoft.public.excel.programming
|
|||
|
|||
Importing XML with partial file name
Did you try the code? it should work. I added the title to the dialog below and changed the zero's and chr(0) to vbNullChar so everything was consistent. Private Type OPENFILENAME lStructSize As Long hwndOwner As Long hInstance As Long lpstrFilter As String lpstrCustomFilter As String 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 String End Type Private Declare Function GetOpenFileNameDLL _ Lib "COMDLG32.DLL" Alias "GetOpenFileNameA" _ (pOpenfilename As OPENFILENAME) As Long Sub test() strFilter = "XML files (*out.xml)" & vbNullChar & "*out.xml" strCaption = "Select an XML File" Dim OFN As OPENFILENAME OFN.lpstrFilter = strFilter OFN.lpstrTitle = strCaption With OFN .lStructSize = Len(OFN) ' Size of structure. .nMaxFile = 260 ' Size of buffer. ' Create buffer. .lpstrFile = String(.nMaxFile - 1, vbNullChar) Ret = GetOpenFileNameDLL(OFN) ' Call function. If Ret < 0 Then ' Non-zero is success. ' Find first null char. n = InStr(.lpstrFile, vbNullChar) ' Return what's before it. MsgBox Left(.lpstrFile, n - 1) End If End With End Sub "Don Kline" wrote: I just did a search and I do have the COMDLG#@.DLL "Joel" wrote: I'm running it also under excel 2003. The microsoft website says some windows releases didn't include COMDLG32.DLL in the windows\system32 folder. If your system doesn't have the file simply copy the file from a PC that has the DLL. All DLL's can be used in VBA code as long as you properly define the DLL properly with the correct entry point. Since a DLL has many entry point the entry point is usually the calling name with the letter A (GetOpenFileNameA) at the end. In some cases different operating systems such as Vista and XP may have different entry points so there may be a B, C, D entry points. "Don Kline" wrote: I'm running in Excel 2003. May I assume that I would have the requisite DLL? "Joel" wrote: The code below will work. With the DLL you seperate the two parts of the filter with a NULL character (chr(0)). Private Type OPENFILENAME lStructSize As Long hwndOwner As Long hInstance As Long lpstrFilter As String lpstrCustomFilter As String 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 String End Type Private Declare Function GetOpenFileNameDLL _ Lib "COMDLG32.DLL" Alias "GetOpenFileNameA" _ (pOpenfilename As OPENFILENAME) As Long Sub test() strFilter = "XML files (*out.xml)" & Chr(0) & "*out.xml" 'strFilter = "*.xml" Dim OFN As OPENFILENAME OFN.lpstrFilter = strFilter With OFN .lStructSize = Len(OFN) ' Size of structure. .nMaxFile = 260 ' Size of buffer. ' Create buffer. .lpstrFile = String(.nMaxFile - 1, 0) Ret = GetOpenFileNameDLL(OFN) ' Call function. If Ret < 0 Then ' Non-zero is success. ' Find first null char. n = InStr(.lpstrFile, vbNullChar) ' Return what's before it. MsgBox Left(.lpstrFile, n - 1) End If End With End Sub "Joel" wrote: You need to use the win32 dll. See thie artice http://msdn.microsoft.com/en-us/libr...ffice.10).aspx Here is the start for the code. I don't have time right now to complete the request. If you need more help let me know. I call the name of the function GetOpenFileNameDLL instead of GetOpenFileName so it wouldn't get confused with the VBA function name. Private Type OPENFILENAME lStructSize As Long hwndOwner As Long hInstance As Long lpstrFilter As String lpstrCustomFilter As String 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 String End Type Private Declare Function GetOpenFileNameDLL _ Lib "COMDLG32.DLL" Alias "GetOpenFileNameA" _ (pOpenfilename As OPENFILENAME) As Long Sub test() Dim OFN As OPENFILENAME With OFN .lStructSize = Len(OFN) ' Size of structure. .nMaxFile = 260 ' Size of buffer. ' Create buffer. .lpstrFile = String(.nMaxFile - 1, 0) Ret = GetOpenFileNameDLL(OFN) ' Call function. If Ret < 0 Then ' Non-zero is success. ' Find first null char. n = InStr(.lpstrFile, vbNullChar) ' Return what's before it. MsgBox Left(.lpstrFile, n - 1) End If End With End Sub "Patrick Molloy" wrote: er sName = Dir("C:\Users\Patrick.Patrick-PC\Excel/" & FileFilter) replace by whatever folder you need sName = Dir("C:\path\" & FileFilter) "Patrick Molloy" wrote in message ... unfortunately I don't think that its possible to create a filter this way. I'd suggest that you use your own userform for this replace your Application.GetOpenFileName.... by FetchFiles Option Explicit Sub demo() Dim strSelectedFile As String strSelectedFile = Application.GetOpenFilename("*OUT.XML") End Sub Function FetchFiles(sFilter As String) Load UserForm1 UserForm1.FileFilter = sFilter UserForm1.Show FetchFiles = UserForm1.SelectedFile Unload UserForm1 End Function add a userform, userform1. with three controls command button, cmdOpen, caption: Open command button, cmdCancel, caption: Cancel Listbox, listbox1 and this code behind the userform: Option Explicit Public FileFilter As String Public SelectedFile As String Private Sub cmdCancel_Click() SelectedFile = "False" Me.Hide End Sub Private Sub cmdOpen_Click() If ListBox1.ListIndex < -1 Then SelectedFile = ListBox1 Else SelectedFile = "False" End If Me.Hide End Sub Private Sub UserForm_Initialize() Dim sName As String sName = Dir("C:\Users\Patrick.Patrick-PC\Excel/" & FileFilter) Do While sName < "" ListBox1.AddItem sName sName = Dir Loop End Sub "Don Kline" wrote in message ... I have to select and import files all day long with an XML extension. Two files are imported for each case. The file names are paired with one file ending with "OUT.XML" and its companion file ends with "INI.XML". What I want to do is when the end user gets to the point of selecting the *OUT.XML that it only shows the files ending in *OUT.XML. The code is set up to automatically pick up the INI file. Yet when I get to the point at which the macro displays the list of available files, I see both files - the OUT.XML and the INI.XML. How can I limit the selection to the *OUT.XML". Sub ImportXMLFile() Set wbMain = ThisWorkbook Set wsInputs = wbMain.Worksheets("GUI") Set wsXMLSource = wbMain.Worksheets("XMLSource") Set wsColumnParse = wbMain.Worksheets("ColumnParse") Set wsXMLINI = wbMain.Worksheets("XMLINI") strRelayOutSourceDir = wsInputs.Range("D22") ChDirNet strRelayOutSourceDir strFilter = "XML files (*out.xml), *out.xml" strCaption = "Select an XML File" strSelectedFile = Application.GetOpenFilename(strFilter, , strCaption) Application.DisplayAlerts = False oldStatusBar = Application.DisplayStatusBar Application.DisplayStatusBar = True Application.StatusBar = "Importing OUT.XML file" 'open selected workbook for the XMLSource Workbooks.OpenXML Filename:=strSelectedFile, LoadOption:= _ xlXmlLoadImportToList Set wbXMLSource = ActiveWorkbook Cells.Select 'pick up the values for the XMLSource tab Selection.Copy Application.DisplayAlerts = False wbMain.Activate wsXMLSource.Activate Cells.PasteSpecial xlPasteValues wbXMLSource.Close (False) Set wbXMLSource = Nothing 'now pick up the INI values Application.StatusBar = "Importing INI file" strSelectedFile = Left(strSelectedFile, Len(strSelectedFile) - 7) strSelectedFile = strSelectedFile + "INI.XML" Workbooks.OpenXML Filename:=strSelectedFile, LoadOption:= _ xlXmlLoadImportToList Set wbXMLINI = ActiveWorkbook Cells.Select Selection.Copy wsXMLINI.Activate Cells.PasteSpecial xlPasteValues wbXMLINI.Close (False) Set wsXMLINI = Nothing Application.StatusBar = False Application.DisplayStatusBar = oldStatusBar wsInputs.Activate Range("B3").Select 'close created objects ' Set wsXMLINI = Nothing Set wsColumnParse = Nothing Set wsInputs = Nothing Set wbMain = Nothing End Sub |
#11
Posted to microsoft.public.excel.programming
|
|||
|
|||
Importing XML with partial file name
Yes - your code does work as I get all of the files with the "*out.xml" and only those files with the "out.xml". The upon selection I get the file path and name. I'll just need to shoehorn it into the existing code. But as I've been at my cubicle for now 12+ hours, I will do that when I am coherent. "Joel" wrote: Did you try the code? it should work. I added the title to the dialog below and changed the zero's and chr(0) to vbNullChar so everything was consistent. Private Type OPENFILENAME lStructSize As Long hwndOwner As Long hInstance As Long lpstrFilter As String lpstrCustomFilter As String 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 String End Type Private Declare Function GetOpenFileNameDLL _ Lib "COMDLG32.DLL" Alias "GetOpenFileNameA" _ (pOpenfilename As OPENFILENAME) As Long Sub test() strFilter = "XML files (*out.xml)" & vbNullChar & "*out.xml" strCaption = "Select an XML File" Dim OFN As OPENFILENAME OFN.lpstrFilter = strFilter OFN.lpstrTitle = strCaption With OFN .lStructSize = Len(OFN) ' Size of structure. .nMaxFile = 260 ' Size of buffer. ' Create buffer. .lpstrFile = String(.nMaxFile - 1, vbNullChar) Ret = GetOpenFileNameDLL(OFN) ' Call function. If Ret < 0 Then ' Non-zero is success. ' Find first null char. n = InStr(.lpstrFile, vbNullChar) ' Return what's before it. MsgBox Left(.lpstrFile, n - 1) End If End With End Sub "Don Kline" wrote: I just did a search and I do have the COMDLG#@.DLL "Joel" wrote: I'm running it also under excel 2003. The microsoft website says some windows releases didn't include COMDLG32.DLL in the windows\system32 folder. If your system doesn't have the file simply copy the file from a PC that has the DLL. All DLL's can be used in VBA code as long as you properly define the DLL properly with the correct entry point. Since a DLL has many entry point the entry point is usually the calling name with the letter A (GetOpenFileNameA) at the end. In some cases different operating systems such as Vista and XP may have different entry points so there may be a B, C, D entry points. "Don Kline" wrote: I'm running in Excel 2003. May I assume that I would have the requisite DLL? "Joel" wrote: The code below will work. With the DLL you seperate the two parts of the filter with a NULL character (chr(0)). Private Type OPENFILENAME lStructSize As Long hwndOwner As Long hInstance As Long lpstrFilter As String lpstrCustomFilter As String 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 String End Type Private Declare Function GetOpenFileNameDLL _ Lib "COMDLG32.DLL" Alias "GetOpenFileNameA" _ (pOpenfilename As OPENFILENAME) As Long Sub test() strFilter = "XML files (*out.xml)" & Chr(0) & "*out.xml" 'strFilter = "*.xml" Dim OFN As OPENFILENAME OFN.lpstrFilter = strFilter With OFN .lStructSize = Len(OFN) ' Size of structure. .nMaxFile = 260 ' Size of buffer. ' Create buffer. .lpstrFile = String(.nMaxFile - 1, 0) Ret = GetOpenFileNameDLL(OFN) ' Call function. If Ret < 0 Then ' Non-zero is success. ' Find first null char. n = InStr(.lpstrFile, vbNullChar) ' Return what's before it. MsgBox Left(.lpstrFile, n - 1) End If End With End Sub "Joel" wrote: You need to use the win32 dll. See thie artice http://msdn.microsoft.com/en-us/libr...ffice.10).aspx Here is the start for the code. I don't have time right now to complete the request. If you need more help let me know. I call the name of the function GetOpenFileNameDLL instead of GetOpenFileName so it wouldn't get confused with the VBA function name. Private Type OPENFILENAME lStructSize As Long hwndOwner As Long hInstance As Long lpstrFilter As String lpstrCustomFilter As String 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 String End Type Private Declare Function GetOpenFileNameDLL _ Lib "COMDLG32.DLL" Alias "GetOpenFileNameA" _ (pOpenfilename As OPENFILENAME) As Long Sub test() Dim OFN As OPENFILENAME With OFN .lStructSize = Len(OFN) ' Size of structure. .nMaxFile = 260 ' Size of buffer. ' Create buffer. .lpstrFile = String(.nMaxFile - 1, 0) Ret = GetOpenFileNameDLL(OFN) ' Call function. If Ret < 0 Then ' Non-zero is success. ' Find first null char. n = InStr(.lpstrFile, vbNullChar) ' Return what's before it. MsgBox Left(.lpstrFile, n - 1) End If End With End Sub "Patrick Molloy" wrote: er sName = Dir("C:\Users\Patrick.Patrick-PC\Excel/" & FileFilter) replace by whatever folder you need sName = Dir("C:\path\" & FileFilter) "Patrick Molloy" wrote in message ... unfortunately I don't think that its possible to create a filter this way. I'd suggest that you use your own userform for this replace your Application.GetOpenFileName.... by FetchFiles Option Explicit Sub demo() Dim strSelectedFile As String strSelectedFile = Application.GetOpenFilename("*OUT.XML") End Sub Function FetchFiles(sFilter As String) Load UserForm1 UserForm1.FileFilter = sFilter UserForm1.Show FetchFiles = UserForm1.SelectedFile Unload UserForm1 End Function add a userform, userform1. with three controls command button, cmdOpen, caption: Open command button, cmdCancel, caption: Cancel Listbox, listbox1 and this code behind the userform: Option Explicit Public FileFilter As String Public SelectedFile As String Private Sub cmdCancel_Click() SelectedFile = "False" Me.Hide End Sub Private Sub cmdOpen_Click() If ListBox1.ListIndex < -1 Then SelectedFile = ListBox1 Else SelectedFile = "False" End If Me.Hide End Sub Private Sub UserForm_Initialize() Dim sName As String sName = Dir("C:\Users\Patrick.Patrick-PC\Excel/" & FileFilter) Do While sName < "" ListBox1.AddItem sName sName = Dir Loop End Sub "Don Kline" wrote in message ... I have to select and import files all day long with an XML extension. Two files are imported for each case. The file names are paired with one file ending with "OUT.XML" and its companion file ends with "INI.XML". What I want to do is when the end user gets to the point of selecting the *OUT.XML that it only shows the files ending in *OUT.XML. The code is set up to automatically pick up the INI file. Yet when I get to the point at which the macro displays the list of available files, I see both files - the OUT.XML and the INI.XML. How can I limit the selection to the *OUT.XML". Sub ImportXMLFile() Set wbMain = ThisWorkbook Set wsInputs = wbMain.Worksheets("GUI") Set wsXMLSource = wbMain.Worksheets("XMLSource") Set wsColumnParse = wbMain.Worksheets("ColumnParse") Set wsXMLINI = wbMain.Worksheets("XMLINI") strRelayOutSourceDir = wsInputs.Range("D22") ChDirNet strRelayOutSourceDir strFilter = "XML files (*out.xml), *out.xml" strCaption = "Select an XML File" strSelectedFile = Application.GetOpenFilename(strFilter, , strCaption) Application.DisplayAlerts = False oldStatusBar = Application.DisplayStatusBar Application.DisplayStatusBar = True Application.StatusBar = "Importing OUT.XML file" 'open selected workbook for the XMLSource Workbooks.OpenXML Filename:=strSelectedFile, LoadOption:= _ xlXmlLoadImportToList Set wbXMLSource = ActiveWorkbook Cells.Select |
#12
Posted to microsoft.public.excel.programming
|
|||
|
|||
Importing XML with partial file name
Patrick - I appreiate your help but I want to try installing Joel's method first. But that will wait until tomorrow as I am fried. "Patrick Molloy" wrote: er sName = Dir("C:\Users\Patrick.Patrick-PC\Excel/" & FileFilter) replace by whatever folder you need sName = Dir("C:\path\" & FileFilter) "Patrick Molloy" wrote in message ... unfortunately I don't think that its possible to create a filter this way. I'd suggest that you use your own userform for this replace your Application.GetOpenFileName.... by FetchFiles Option Explicit Sub demo() Dim strSelectedFile As String strSelectedFile = Application.GetOpenFilename("*OUT.XML") End Sub Function FetchFiles(sFilter As String) Load UserForm1 UserForm1.FileFilter = sFilter UserForm1.Show FetchFiles = UserForm1.SelectedFile Unload UserForm1 End Function add a userform, userform1. with three controls command button, cmdOpen, caption: Open command button, cmdCancel, caption: Cancel Listbox, listbox1 and this code behind the userform: Option Explicit Public FileFilter As String Public SelectedFile As String Private Sub cmdCancel_Click() SelectedFile = "False" Me.Hide End Sub Private Sub cmdOpen_Click() If ListBox1.ListIndex < -1 Then SelectedFile = ListBox1 Else SelectedFile = "False" End If Me.Hide End Sub Private Sub UserForm_Initialize() Dim sName As String sName = Dir("C:\Users\Patrick.Patrick-PC\Excel/" & FileFilter) Do While sName < "" ListBox1.AddItem sName sName = Dir Loop End Sub "Don Kline" wrote in message ... I have to select and import files all day long with an XML extension. Two files are imported for each case. The file names are paired with one file ending with "OUT.XML" and its companion file ends with "INI.XML". What I want to do is when the end user gets to the point of selecting the *OUT.XML that it only shows the files ending in *OUT.XML. The code is set up to automatically pick up the INI file. Yet when I get to the point at which the macro displays the list of available files, I see both files - the OUT.XML and the INI.XML. How can I limit the selection to the *OUT.XML". Sub ImportXMLFile() Set wbMain = ThisWorkbook Set wsInputs = wbMain.Worksheets("GUI") Set wsXMLSource = wbMain.Worksheets("XMLSource") Set wsColumnParse = wbMain.Worksheets("ColumnParse") Set wsXMLINI = wbMain.Worksheets("XMLINI") strRelayOutSourceDir = wsInputs.Range("D22") ChDirNet strRelayOutSourceDir strFilter = "XML files (*out.xml), *out.xml" strCaption = "Select an XML File" strSelectedFile = Application.GetOpenFilename(strFilter, , strCaption) Application.DisplayAlerts = False oldStatusBar = Application.DisplayStatusBar Application.DisplayStatusBar = True Application.StatusBar = "Importing OUT.XML file" 'open selected workbook for the XMLSource Workbooks.OpenXML Filename:=strSelectedFile, LoadOption:= _ xlXmlLoadImportToList Set wbXMLSource = ActiveWorkbook Cells.Select 'pick up the values for the XMLSource tab Selection.Copy Application.DisplayAlerts = False wbMain.Activate wsXMLSource.Activate Cells.PasteSpecial xlPasteValues wbXMLSource.Close (False) Set wbXMLSource = Nothing 'now pick up the INI values Application.StatusBar = "Importing INI file" strSelectedFile = Left(strSelectedFile, Len(strSelectedFile) - 7) strSelectedFile = strSelectedFile + "INI.XML" Workbooks.OpenXML Filename:=strSelectedFile, LoadOption:= _ xlXmlLoadImportToList Set wbXMLINI = ActiveWorkbook Cells.Select Selection.Copy wsXMLINI.Activate Cells.PasteSpecial xlPasteValues wbXMLINI.Close (False) Set wsXMLINI = Nothing Application.StatusBar = False Application.DisplayStatusBar = oldStatusBar wsInputs.Activate Range("B3").Select 'close created objects ' Set wsXMLINI = Nothing Set wsColumnParse = Nothing Set wsInputs = Nothing Set wbMain = Nothing End Sub |
#13
Posted to microsoft.public.excel.programming
|
|||
|
|||
Importing XML with partial file name
I did it for you and made some improvements to the code. I often have to
resort to using DLL when the VBA code that should work doesn't!!!!!!! Private Type OPENFILENAME lStructSize As Long hwndOwner As Long hInstance As Long lpstrFilter As String lpstrCustomFilter As String 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 String End Type Private Declare Function GetOpenFileNameDLL _ Lib "COMDLG32.DLL" Alias "GetOpenFileNameA" _ (pOpenfilename As OPENFILENAME) As Long Sub ImportXMLFile() Dim OFN As OPENFILENAME Set wbMain = ThisWorkbook Set wsInputs = wbMain.Worksheets("GUI") Set wsXMLSource = wbMain.Worksheets("XMLSource") Set wsColumnParse = wbMain.Worksheets("ColumnParse") Set wsXMLINI = wbMain.Worksheets("XMLINI") strRelayOutSourceDir = wsInputs.Range("D22") ChDirNet strRelayOutSourceDir strFilter = "XML files (*out.xml), *out.xml" strCaption = "Select an XML File" OFN.lpstrFilter = strFilter OFN.lpstrTitle = strCaption With OFN .lStructSize = Len(OFN) ' Size of structure. .nMaxFile = 260 ' Size of buffer. ' Create buffer. .lpstrFile = String(.nMaxFile - 1, vbNullChar) Ret = GetOpenFileNameDLL(OFN) ' Call function. If Ret < 0 Then ' Non-zero is success. ' Find first null char. n = InStr(.lpstrFile, vbNullChar) ' Return what's before it. strSelectedFile = Left(.lpstrFile, n - 1) Else MsgBox ("Cannot open file - Exiting Macro") Exit Sub End If End With Application.DisplayAlerts = False oldStatusBar = Application.DisplayStatusBar Application.DisplayStatusBar = True Application.StatusBar = "Importing OUT.XML file" 'open selected workbook for the XMLSource Set wbXMLSource = Workbooks.OpenXML(Filename:=strSelectedFile, _ LoadOption:=xlXmlLoadImportToList) Application.DisplayAlerts = False With wbXMLSource.ActiveSheet 'pick up the values for the XMLSource tab .Cells.Copy End With With wsXMLSource .Cells.PasteSpecial _ Paste:=xlPasteValues End With wbXMLSource.Close savechanges:=False Set wbXMLSource = Nothing 'now pick up the INI values Application.StatusBar = "Importing INI file" strSelectedFile = Left(strSelectedFile, Len(strSelectedFile) - 7) strSelectedFile = strSelectedFile + "INI.XML" Set wbXMLINI = Workbooks.OpenXML(Filename:=strSelectedFile, _ LoadOption:=xlXmlLoadImportToList) With wbXMLINI.ActiveSheet .Cells.Copy End With With wsXMLINI .Cells.PasteSpecial _ Paste:=xlPasteValues End With wbXMLINI.Close savechanges:=False Set wsXMLINI = Nothing Application.StatusBar = False Application.DisplayStatusBar = oldStatusBar wsInputs.Activate Range("B3").Select 'close created objects Set wsXMLINI = Nothing Set wsColumnParse = Nothing Set wsInputs = Nothing Set wbMain = Nothing End Sub "Don Kline" wrote: Yes - your code does work as I get all of the files with the "*out.xml" and only those files with the "out.xml". The upon selection I get the file path and name. I'll just need to shoehorn it into the existing code. But as I've been at my cubicle for now 12+ hours, I will do that when I am coherent. "Joel" wrote: Did you try the code? it should work. I added the title to the dialog below and changed the zero's and chr(0) to vbNullChar so everything was consistent. Private Type OPENFILENAME lStructSize As Long hwndOwner As Long hInstance As Long lpstrFilter As String lpstrCustomFilter As String 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 String End Type Private Declare Function GetOpenFileNameDLL _ Lib "COMDLG32.DLL" Alias "GetOpenFileNameA" _ (pOpenfilename As OPENFILENAME) As Long Sub test() strFilter = "XML files (*out.xml)" & vbNullChar & "*out.xml" strCaption = "Select an XML File" Dim OFN As OPENFILENAME OFN.lpstrFilter = strFilter OFN.lpstrTitle = strCaption With OFN .lStructSize = Len(OFN) ' Size of structure. .nMaxFile = 260 ' Size of buffer. ' Create buffer. .lpstrFile = String(.nMaxFile - 1, vbNullChar) Ret = GetOpenFileNameDLL(OFN) ' Call function. If Ret < 0 Then ' Non-zero is success. ' Find first null char. n = InStr(.lpstrFile, vbNullChar) ' Return what's before it. MsgBox Left(.lpstrFile, n - 1) End If End With End Sub "Don Kline" wrote: I just did a search and I do have the COMDLG#@.DLL "Joel" wrote: I'm running it also under excel 2003. The microsoft website says some windows releases didn't include COMDLG32.DLL in the windows\system32 folder. If your system doesn't have the file simply copy the file from a PC that has the DLL. All DLL's can be used in VBA code as long as you properly define the DLL properly with the correct entry point. Since a DLL has many entry point the entry point is usually the calling name with the letter A (GetOpenFileNameA) at the end. In some cases different operating systems such as Vista and XP may have different entry points so there may be a B, C, D entry points. "Don Kline" wrote: I'm running in Excel 2003. May I assume that I would have the requisite DLL? "Joel" wrote: The code below will work. With the DLL you seperate the two parts of the filter with a NULL character (chr(0)). Private Type OPENFILENAME lStructSize As Long hwndOwner As Long hInstance As Long lpstrFilter As String lpstrCustomFilter As String 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 String End Type Private Declare Function GetOpenFileNameDLL _ Lib "COMDLG32.DLL" Alias "GetOpenFileNameA" _ (pOpenfilename As OPENFILENAME) As Long Sub test() strFilter = "XML files (*out.xml)" & Chr(0) & "*out.xml" 'strFilter = "*.xml" Dim OFN As OPENFILENAME OFN.lpstrFilter = strFilter With OFN .lStructSize = Len(OFN) ' Size of structure. .nMaxFile = 260 ' Size of buffer. ' Create buffer. .lpstrFile = String(.nMaxFile - 1, 0) Ret = GetOpenFileNameDLL(OFN) ' Call function. If Ret < 0 Then ' Non-zero is success. ' Find first null char. n = InStr(.lpstrFile, vbNullChar) ' Return what's before it. MsgBox Left(.lpstrFile, n - 1) End If End With End Sub "Joel" wrote: You need to use the win32 dll. See thie artice http://msdn.microsoft.com/en-us/libr...ffice.10).aspx Here is the start for the code. I don't have time right now to complete the request. If you need more help let me know. I call the name of the function GetOpenFileNameDLL instead of GetOpenFileName so it wouldn't get confused with the VBA function name. Private Type OPENFILENAME lStructSize As Long hwndOwner As Long hInstance As Long lpstrFilter As String lpstrCustomFilter As String 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 String End Type Private Declare Function GetOpenFileNameDLL _ Lib "COMDLG32.DLL" Alias "GetOpenFileNameA" _ (pOpenfilename As OPENFILENAME) As Long Sub test() Dim OFN As OPENFILENAME With OFN .lStructSize = Len(OFN) ' Size of structure. .nMaxFile = 260 ' Size of buffer. ' Create buffer. .lpstrFile = String(.nMaxFile - 1, 0) Ret = GetOpenFileNameDLL(OFN) ' Call function. If Ret < 0 Then ' Non-zero is success. ' Find first null char. n = InStr(.lpstrFile, vbNullChar) ' Return what's before it. MsgBox Left(.lpstrFile, n - 1) End If End With End Sub "Patrick Molloy" wrote: er sName = Dir("C:\Users\Patrick.Patrick-PC\Excel/" & FileFilter) replace by whatever folder you need sName = Dir("C:\path\" & FileFilter) "Patrick Molloy" wrote in message ... unfortunately I don't think that its possible to create a filter this way. I'd suggest that you use your own userform for this replace your Application.GetOpenFileName.... by FetchFiles Option Explicit Sub demo() Dim strSelectedFile As String strSelectedFile = Application.GetOpenFilename("*OUT.XML") End Sub Function FetchFiles(sFilter As String) Load UserForm1 UserForm1.FileFilter = sFilter UserForm1.Show FetchFiles = UserForm1.SelectedFile Unload UserForm1 End Function add a userform, userform1. with three controls command button, cmdOpen, caption: Open command button, cmdCancel, caption: Cancel Listbox, listbox1 and this code behind the userform: Option Explicit Public FileFilter As String Public SelectedFile As String Private Sub cmdCancel_Click() SelectedFile = "False" Me.Hide End Sub Private Sub cmdOpen_Click() If ListBox1.ListIndex < -1 Then SelectedFile = ListBox1 Else SelectedFile = "False" End If Me.Hide End Sub Private Sub UserForm_Initialize() Dim sName As String sName = Dir("C:\Users\Patrick.Patrick-PC\Excel/" & FileFilter) Do While sName < "" ListBox1.AddItem sName sName = Dir Loop End Sub "Don Kline" wrote in message ... I have to select and import files all day long with an XML extension. Two files are imported for each case. The file names are paired with one file ending with "OUT.XML" and its companion file ends with "INI.XML". What I want to do is when the end user gets to the point of selecting the *OUT.XML that it only shows the files ending in *OUT.XML. The code is set up to automatically pick up the INI file. Yet when I get to the point at which the macro displays the list of available files, I see both files - the OUT.XML and the INI.XML. How can I limit the selection to the *OUT.XML". Sub ImportXMLFile() Set wbMain = ThisWorkbook Set wsInputs = wbMain.Worksheets("GUI") Set wsXMLSource = wbMain.Worksheets("XMLSource") Set wsColumnParse = wbMain.Worksheets("ColumnParse") Set wsXMLINI = wbMain.Worksheets("XMLINI") strRelayOutSourceDir = wsInputs.Range("D22") ChDirNet strRelayOutSourceDir strFilter = "XML files (*out.xml), *out.xml" strCaption = "Select an XML File" strSelectedFile = Application.GetOpenFilename(strFilter, , strCaption) Application.DisplayAlerts = False oldStatusBar = Application.DisplayStatusBar ----------------------------------------------------------------------------- Our Peering Groups change Visit : http://spacesst.com/peerin |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Locating a file in excel with a partial file name. | Excel Discussion (Misc queries) | |||
Locating a file in excel with a partial file name. | Excel Discussion (Misc queries) | |||
Locating a file in excel with a partial file name. | Excel Discussion (Misc queries) | |||
Locating a file in excel with a partial file name. | Excel Discussion (Misc queries) | |||
Locating a file in excel with a partial file name. | Excel Discussion (Misc queries) |