Solved

Saving XML files using VBA (excel)

Posted on 2011-03-09
7
908 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 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
Revamp Your Training Process

Drastically shorten your training time with WalkMe's advanced online training solution that Guides your trainees to action.

 

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

PeopleSoft Has Never Been Easier

PeopleSoft Adoption Made Smooth & Simple!

On-The-Job Training Is made Intuitive & Easy With WalkMe's On-Screen Guidance Tool.  Claim Your Free WalkMe Account Now

Question has a verified solution.

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

Do you use a spreadsheet like Microsoft's Excel?  Have you ever wanted to link out to a non excel file on your computer or network drive?  This is the way I found to do it!
This article describes a serious pitfall that can happen when deleting shapes using VBA.
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

724 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