Importing XML with partial file name

D

Don Kline

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
 
P

Patrick Molloy

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
 
P

Patrick Molloy

er

sName = Dir("C:\Users\Patrick.Patrick-PC\Excel/" & FileFilter)

replace by whatever folder you need
sName = Dir("C:\path\" & FileFilter)
 
J

Joel

You need to use the win32 dll. See thie artice

http://msdn.microsoft.com/en-us/library/aa155724(office.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
 
J

Joel

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
 
D

Don Kline

Sorry - I keep getting shanghaied into meetings. I have not yet had the time
to get this working.
 
J

Joel

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.
 
J

Joel

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
 
D

Don Kline

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.
 
D

Don Kline

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.
 
J

Joel

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
 

Ask a Question

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

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

Ask a Question

Similar Threads

Padding in cells added to imported spreadsheet 2
Workbooks.OpenText Error 1004 3
Reading through an XML file 3
Selection.Sort Key1: Problem 4
Don't want to hard-code file name in macro 3
Problem: Cells show 0 despite formulas 2
Importing Text file (Again) 3
Code corrupts file (XL2003) 3

Top