Solved

Saving XML files using VBA (excel)

Posted on 2011-03-09
7
902 Views
Last Modified: 2012-05-11
I hold a folder which contains 100s of XML files.
The XML files hold the following naming convention: DETAILS28ABC.xml
DETAILS28 is available in ALL files. The change is the 'ABC' code which appears before the .xml extension.

Requirement:
Read each XML file and save the data in Excel sheet (if possible with the name of the sheet as 'ABC').
XML is in the following format:
<?xml version="1.0" encoding="ISO-8859-1"?>
<SOAP-ENV:Envelope xmlns:SOAP-ENV="http://schemas.xmlsoap.org/soap/envelope/" xmlns:xsd="http://www.w3.org/1999/XMLSchema" xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance">
<SOAP-ENV:Body>
<return>
	<lab>
		<name>Joseph Dsliva</name>
		<company>Jose &amp; company</company>
		<groupname>C</groupname>
		<sequencenumber>1</sequencenumber>
	</lab>
	<lab>
		<name>John</name>
		<company>XMY company</company>
		<groupname>D</groupname>
		<sequencenumber>3</sequencenumber>
	</lab>
</return>
</SOAP-ENV:Body>
</SOAP-ENV:Envelope>

Open in new window


Below is the Excel VBA Code I am using to traverse through a directory:
Sub LoopFiles1()

Static MyFileName, MyPath As String
Dim MyBook As Workbook

    Dim NextRow As Long
    

	MyPath = "C:\V3-Survey-Results\"
	MyFileName = Dir(MyPath & "*.xml")

Do Until MyFileName = ""

'' process / save content from XML file
'' in Excel with the name of the filename available in the SHEET name

Loop
End Sub

Open in new window

0
Comment
Question by:nainil
  • 4
  • 3
7 Comments
 
LVL 10

Expert Comment

by:Jon von der Heyden
ID: 35092283
For example:
Sub LoopFiles1()
    Static MyFileName, MyPath As String

    MyPath = "C:\Users\User\Documents\Test\"
    MyFileName = Dir(MyPath & "*.xml")
    
    Application.DisplayAlerts = False
    
    Do While Len(MyFileName) > 0
        With Sheets.Add
            .Name = Left$(Right$(MyFileName, 7), 3)
            With .QueryTables.Add(Connection:= _
                                 "FINDER;" & MyPath & MyFileName, _
                                  Destination:=.Range("A1"))
                .Name = .Parent.Name
                '.FieldNames = True
                '.RowNumbers = False
                '.FillAdjacentFormulas = False
                '.PreserveFormatting = True
                '.RefreshOnFileOpen = False
                '.BackgroundQuery = True
                '.RefreshStyle = xlInsertDeleteCells
                '.SavePassword = False
                '.SaveData = True
                '.AdjustColumnWidth = True
                '.RefreshPeriod = 0
                '.WebSelectionType = xlAllTables
                '.WebFormatting = xlWebFormattingNone
                '.WebPreFormattedTextToColumns = True
                '.WebConsecutiveDelimitersAsOne = True
                '.WebSingleBlockTextImport = False
                '.WebDisableDateRecognition = False
                '.WebDisableRedirections = False
                '.Refresh BackgroundQuery:=False
            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


I've commented out the various query table properties, but left them in so you can change as required.
0
 

Author Comment

by:nainil
ID: 35101960
@JONvdHeyden:
This worked.

However, I have another quick request.

1. How can I enable a dialog box to show up to select the "Directory" instead of hardcoding it 'MyPath'.

Something similar to:
Function GetFolder(strPath As String) As String
Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
    .Title = "Select a Folder"
    .AllowMultiSelect = False
    .InitialFileName = strPath
    If .Show <> -1 Then GoTo NextCode
    sItem = .SelectedItems(1)
End With
NextCode:
GetFolder = sItem
Set fldr = Nothing
End Function

2. How does the left / right function work to extract the file name...?
XML Files follow the following convention:
Details12<CODE>.xml
<CODE> = Variable length

So, if the sheets could come up with the name of the CODE, it will be wonderful.
0
 
LVL 10

Accepted Solution

by:
Jon von der Heyden earned 500 total points
ID: 35105951
Hello

See the following code:
Sub LoopFiles1()
    Static MyFileName, MyPath As String
    
    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
        With Sheets.Add
            .Name = Split(Mid$(MyFileName, 10), ".")(0)
            With .QueryTables.Add(Connection:= _
                                 "FINDER;" & MyPath & MyFileName, _
                                  Destination:=.Range("A1"))
                .Name = .Parent.Name
                '.FieldNames = True
                '.RowNumbers = False
                '.FillAdjacentFormulas = False
                '.PreserveFormatting = True
                '.RefreshOnFileOpen = False
                '.BackgroundQuery = True
                '.RefreshStyle = xlInsertDeleteCells
                '.SavePassword = False
                '.SaveData = True
                '.AdjustColumnWidth = True
                '.RefreshPeriod = 0
                '.WebSelectionType = xlAllTables
                '.WebFormatting = xlWebFormattingNone
                '.WebPreFormattedTextToColumns = True
                '.WebConsecutiveDelimitersAsOne = True
                '.WebSingleBlockTextImport = False
                '.WebDisableDateRecognition = False
                '.WebDisableRedirections = False
                '.Refresh BackgroundQuery:=False
            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


Using a file picker to determine the path...
Now assumes that the filename is always Details##<CODE>.xml, I am using Mid to extract from the 10th character onward (e.g. <CODE..xml) and the splitting it into two substrings, using "." as delimiter and then returning the 1st item of the array (using zero because array is zero-based).

Hope this makes sense, hope it helps. :)

Cheers

Jon von der Heyden
0
Better Security Awareness With Threat Intelligence

See how one of the leading financial services organizations uses Recorded Future as part of a holistic threat intelligence program to promote security awareness and proactively and efficiently identify threats.

 

Author Comment

by:nainil
ID: 35124959
Thank you JONvdHeyden:

Your code worked perfectly. Appreciate your help.
There is a small issue :

There are three different types of files in the directory.

chikeysitems28<CODE>.xml
chiparameters28<CODE>.xml
chisegmentdetails28<CODE>.xml

I read the first file, and it will create a sheet with the name of <CODE>. If the second file with the same code comes, i would like to see it appended to the <CODE> sheet already present, and so on.

My updated code is below. Any help is appreciated.
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)
            mysheetname = vLookup(sheetname)
        Else
        
        chksheetname = LCase(Mid$(MyFileName, 16))
        
            If chksheetname = "chiparameters28" Then
                
                sheetname = Split(Mid$(MyFileName, 16), ".")(0)
                mysheetname = vLookup(sheetname)
                
                FileType = 2
            Else
                FileType = 3
                
                sheetname = Split(Mid$(MyFileName, 20), ".")(0)
                mysheetname = vLookup(sheetname)
                
            End If
        
        End If
    
        With Sheets.Add

            .Name = mysheetname
            
            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

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
'MsgBox "The look-up value of " & lookFor & " is " & found & " in column " & col

End If
On Error GoTo 0

'
End Function

Open in new window

0
 
LVL 10

Expert Comment

by:Jon von der Heyden
ID: 35135577
I don't suppose you can attach a couple of sample files?  The only real change here is that you need to note where the query table ends and then use the next cell down as the Destination.  But you might want to also destroy the query table and keep the data as constant only.
0
 

Author Comment

by:nainil
ID: 35139663
Sorry, i should have provided some sample files.

Attached are the same. PS: the xml content is just sample, but the files are named correctly as expected.

Just to clarify:

All files having the same <CODE>, need to get in the same sheet.
If we have three files with CODE=XYZ, all the xml content should be appended to the sheet created.

If there is just 1 file for a CODE, then, that comes as a separate file like before.

Hope it helps... thank you for your help so far!
test.zip
0
 

Author Comment

by:nainil
ID: 35176207
@JONvdHeyden:

Do you think you can help me further?

Or someone else? I can re-define my issue if it is confusing...
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

This article is the result of a quest to better understand Task Scheduler 2.0 and all the newer objects available in vbscript in this version over  the limited options we had scripting in Task Scheduler 1.0.  As I started my journey of knowledge I f…
Background What I'm presenting in this article is the result of 2 conditions in my work area: We have a SQL Server production environment but no development or test environment; andWe have an MS Access front end using tables in SQL Server but we a…
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 demonstrates in Microsoft Excel how to consolidate your marketing data by creating an interactive charts using form controls. This creates cool drop-downs for viewers of your chart to choose from.

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

19 Experts available now in Live!

Get 1:1 Help Now