Solved

Saving XML files using VBA (excel)

Posted on 2011-03-09
7
905 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
Announcing the Most Valuable Experts of 2016

MVEs are more concerned with the satisfaction of those they help than with the considerable points they can earn. They are the types of people you feel privileged to call colleagues. Join us in honoring this amazing group of Experts.

 

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

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

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…
Some code to ensure data integrity when using macros within Excel. Also included code that helps secure your data within an Excel workbook.
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.
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…

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