?
Solved

Saving XML files using VBA (excel)

Posted on 2011-03-09
7
Medium Priority
?
910 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 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 2000 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
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 

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

What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

Question has a verified solution.

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

This article will guide you to convert a grid from a picture into Excel format using Microsoft OneNote and no other 3rd party application.
Excel can be a tricky bit of software to get your head around. Whilst you’ll be able to eventually get to grips with the basic understanding of how to get by, there are a few Excel tips that not everybody will even know about let alone know how to d…
This Micro Tutorial demonstrate the bugs in Microsoft Excel for Mac with Pivot Charts.
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…

777 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