Solved

Open XML files in Excel

Posted on 2011-03-22
6
854 Views
Last Modified: 2012-05-11
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
Comment
Question by:nainil
  • 3
  • 2
6 Comments
 
LVL 4

Accepted Solution

by:
MeLindaJohnson earned 500 total points
ID: 35194303
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
 

Author Comment

by:nainil
ID: 35194979
Thank you MeLindaJohnson. however, I am tied to use excel only.
0
 
LVL 4

Assisted Solution

by:MeLindaJohnson
MeLindaJohnson earned 500 total points
ID: 35201068
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
Networking for the Cloud Era

Join Microsoft and Riverbed for a discussion and demonstration of enhancements to SteelConnect:
-One-click orchestration and cloud connectivity in Azure environments
-Tight integration of SD-WAN and WAN optimization capabilities
-Scalability and resiliency equal to a data center

 
LVL 4

Assisted Solution

by:MeLindaJohnson
MeLindaJohnson earned 500 total points
ID: 35201087
Oh, did you try looking at XMLImportXML function in excel?
0
 

Author Comment

by:nainil
ID: 35224217
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
 
LVL 1

Expert Comment

by:acstit
ID: 36453435
Nainil - Thanks for the code.

Solved an issue I had with importing XML

:-)
0

Featured Post

Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This tutorial explains how to create a series of drop-down lists that are dependent upon prior selections to guide (“force”) the user to make the correct selection and reduce data errors within Microsoft Excel. Excel 2010 was used for this tutorial;…
If you need to start windows update installation remotely or as a scheduled task you will find this very helpful.
The viewer will learn how to use the =DISCRINV command to create a discrete random variable, use this command to model a set of probabilities and outcomes in a Monte Carlo simulation, and learn how to find the standard deviation of a set of probabil…
The viewer will learn how to create a normally distributed random variable in Excel, use a normal distribution to simulate the return on an investment over a period of years, Create a Monte Carlo simulation using a normal random variable, and calcul…

830 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question