• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 892
  • Last Modified:

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

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

Open in new window


Also, I am attaching a few sample files to process.

Any help is appreciated.
test.zip
0
nainil
Asked:
nainil
  • 3
  • 2
3 Solutions
 
MeLindaJohnsonCommented:
Did you look at the importxml method?

Not sure how to do in vb script but if you used ms access you could put it into tables and then export the tables into excel.

Public Sub test2()
Dim fs, f, f1, fc, s
Dim folderspec
folderspec = "c:\testxml\"

Set fs = CreateObject("Scripting.FileSystemObject")

Set f = fs.GetFolder(folderspec)

Set fc = f.Files

For Each f1 In fc
If f1 Like "*.xml" Then
ImportXML f1, acAppendData
End If
Next

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "note", "c:\testXML\MergedXML.xls"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "plant", "c:\testXML\MergedXML.xls"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "project", "c:\testXML\MergedXML.xls"

End Sub

"note", "plant", "project" are the tablenames in the xml file.
You don't have to create any tables.
The importxml does it automatically.
0
 
nainilAuthor Commented:
Thank you MeLindaJohnson. however, I am tied to use excel only.
0
 
MeLindaJohnsonCommented:
Ok.  Here is what I have tried and it might help.
First open Excel.
Then record a macro (I called mine myXMLImport)
Then open the first file "chikeysitems28PRWEJS2.xml"
A dialog box will pop up.  Choose "Use the XML Source task pane"

From the pane window, drag the column names over so that
To is in A1
From is in B1
Heading is in C1
Body is in D1
This creates the map.

Then right click on the word To in A1.
Click on XML, Click on Import
Choose the same file "chikeysitems28PRWEJS2.xml"

Then right click on the word To in A1.
Click on XML, Click on XML Map Properties choose Append new data to existing XML Table

Then right click on the word To in A1.
Click on XML, Click on Import
Choose the file "chikeysitems28XYZ.xml"

Stop the macro.

View the code in visual basic.  Keep in mind that the code was put in the initial workbook you start with (for me it was book1) but the data and stuff was in book2.

Maybe this may get you started.  I did trying adding the other maps (clicked on XML maps button on XML source task pane) from the other two file types (parameters,details) but it just never seemed to work for me and I didn't want to put more time in it too be honest.

The mapping thing seems to be very important.

I think the MS Access way is a lot faster and simpler, too bad you can't use that. :)

0
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

 
MeLindaJohnsonCommented:
Oh, did you try looking at XMLImportXML function in excel?
0
 
nainilAuthor Commented:
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

Open in new window

0
 
acstitCommented:
Nainil - Thanks for the code.

Solved an issue I had with importing XML

:-)
0

Featured Post

How to Use the Help Bell

Need to boost the visibility of your question for solutions? Use the Experts Exchange Help Bell to confirm priority levels and contact subject-matter experts for question attention.  Check out this how-to article for more information.

  • 3
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now