Solved

Open XML files in Excel

Posted on 2011-03-22
6
842 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
What Should I Do With This Threat Intelligence?

Are you wondering if you actually need threat intelligence? The answer is yes. We explain the basics for creating useful threat intelligence.

 
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

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

Not long ago I saw a question in the VB Script forum that I thought would not take much time. You can read that question (Question ID  (http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_28455246.html)28455246) Here (http…
This article will guide you to convert a grid from a picture into Excel format using Microsoft OneNote and no other 3rd party application.
The viewer will learn how to simulate a series of sales calls dependent on a single skill level and learn how to simulate a series of sales calls dependent on two skill levels. Simulating Independent Sales Calls: Enter .75 into cell C2 – “skill leve…
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.

705 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

Need Help in Real-Time?

Connect with top rated Experts

18 Experts available now in Live!

Get 1:1 Help Now