nainil
asked on
Open XML files in Excel
I have a folder full of XML files. I need to read the XML files and save them in Excel.
chikeysitems28<CODE>.xml
chiparameters28<CODE>.xml
chisegmentdetails28<CODE>. xml
Where <CODE> could be any text, no fixed length. However, the initial part of the file names is always going to be the same. I use the MID function to extract the CODE.
Files with the same <CODE> need to go under the same sheet.
For eg:
chikeysitems28BUNZ.xml
chiparameters28BUNZ.xml
chisegmentdetails28BUNZ.xm l
Above three files should go under a sheet named BUNZ.
chikeysitems28MADL.xml
chiparameters28MADL.xml
Above two files should go under a sheet named MADL.
and so on.
Attached is the code snippet I am using till now...
Also, I am attaching a few sample files to process.
Any help is appreciated.
test.zip
chikeysitems28<CODE>.xml
chiparameters28<CODE>.xml
chisegmentdetails28<CODE>.
Where <CODE> could be any text, no fixed length. However, the initial part of the file names is always going to be the same. I use the MID function to extract the CODE.
Files with the same <CODE> need to go under the same sheet.
For eg:
chikeysitems28BUNZ.xml
chiparameters28BUNZ.xml
chisegmentdetails28BUNZ.xm
Above three files should go under a sheet named BUNZ.
chikeysitems28MADL.xml
chiparameters28MADL.xml
Above two files should go under a sheet named MADL.
and so on.
Attached is the code snippet I am using till now...
Sub LoopFiles2()
Static MyFileName, MyPath As String
Dim sheetname As String
Dim FileType As Integer
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = 0 Then
Exit Sub
Else
MyPath = .SelectedItems(1) & "\"
End If
End With
MyFileName = Dir(MyPath & "*.xml")
Application.DisplayAlerts = False
Do While Len(MyFileName) > 0
chksheetname = LCase(Mid$(MyFileName, 14))
If chksheetname = "chikeysitems28" Then
FileType = 1
sheetname = Split(Mid$(MyFileName, 14), ".")(0)
Else
chksheetname = LCase(Mid$(MyFileName, 16))
If chksheetname = "chiparameters28" Then
sheetname = Split(Mid$(MyFileName, 16), ".")(0)
FileType = 2
Else
FileType = 3
sheetname = Split(Mid$(MyFileName, 20), ".")(0)
End If
End If
With Sheets.Add
.Name = sheetname
With .QueryTables.Add(Connection:= _
"FINDER;" & MyPath & MyFileName, _
Destination:=.Range("A1"))
.Name = .Parent.Name
End With
ThisWorkbook.XmlImport URL:=MyPath & MyFileName, _
ImportMap:=Nothing, _
Overwrite:=True, _
Destination:=.Range("A1")
End With
MyFileName = Dir
Loop
Application.DisplayAlerts = True
End Sub
Also, I am attaching a few sample files to process.
Any help is appreciated.
test.zip
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Finally got it working with the attached code. Thank you for your time and patience.
Sub LoopFiles2()
Static MyFileName, MyPath As String
Dim sheetname As String
Dim FileType As Integer
Dim FINALSHEETNAME As String
Dim lastrownumber As Long
lastrownumer = 0
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = 0 Then
Exit Sub
Else
MyPath = .SelectedItems(1) & "\"
End If
End With
MyFileName = Dir(MyPath & "*.xml")
Application.DisplayAlerts = False
Do While Len(MyFileName) > 0
chksheetname = LCase(Left(MyFileName, 13))
If chksheetname = "chkkeysitem28" Then
sheetname = Split(Mid$(MyFileName, 14), ".")(0)
mysheetname = vLookup(sheetname)
Else
chksheetname = LCase(Left(MyFileName, 15))
If chksheetname = "modparameters28" Then
sheetname = Split(Mid$(MyFileName, 16), ".")(0)
mysheetname = vLookup(sheetname)
Else
chksheetname = LCase(Left(MyFileName, 19))
sheetname = Split(Mid$(MyFileName, 20), ".")(0)
mysheetname = vLookup(sheetname)
End If
End If
FINALSHEETNAME = mysheetname
'check if sheet exists
If WorksheetExists(FINALSHEETNAME) Then
Sheets(FINALSHEETNAME).Activate
'calculate last available row
lastrownumber = Range("A" & Rows.Count).End(xlUp).Row
lastrownumber = lastrownumber + 2
If (IsEmpty(Range("A" & lastrownumber))) Then
Range("A" & lastrownumber).Value = chksheetname
ThisWorkbook.XmlImport URL:=MyPath & MyFileName, _
ImportMap:=Nothing, _
Overwrite:=True, _
Destination:=("A" & lastrownumber + 1)
End If
MyFileName = Dir
Else
With Sheets.Add
.Name = FINALSHEETNAME
Range("A1").Value = FINALSHEETNAME
Range("A3").Value = chksheetname
ThisWorkbook.XmlImport URL:=MyPath & MyFileName, _
ImportMap:=Nothing, _
Overwrite:=True, _
Destination:=.Range("A4")
End With
MyFileName = Dir
End If
Loop
Application.DisplayAlerts = True
End Sub
Function vLookup(cd As String) As String
'
' vLookup function
'
Dim lookFor As String
Dim rng As Range
Dim col As Integer
Dim found As Variant
lookFor = cd
Set rng = Sheets("master").Columns("G:H")
col = 2
On Error Resume Next
found = Application.vLookup(lookFor, rng, col, 0)
If IsError(found) Then
MsgBox lookFor & " not found"
Else:
vLookup = found
End If
On Error GoTo 0
'
End Function
Function WorksheetExists(WSName As String) As Boolean
On Error Resume Next
WorksheetExists = Worksheets(WSName).Name = WSName
On Error GoTo 0
End Function
Nainil - Thanks for the code.
Solved an issue I had with importing XML
:-)
Solved an issue I had with importing XML
:-)
ASKER