Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 913
  • Last Modified:

Saving XML files using VBA (excel)

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
nainil
Asked:
nainil
  • 4
  • 3
1 Solution
 
Jon von der HeydenCommented:
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
 
nainilAuthor Commented:
@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
 
Jon von der HeydenCommented:
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
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

 
nainilAuthor Commented:
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
 
Jon von der HeydenCommented:
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
 
nainilAuthor Commented:
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
 
nainilAuthor Commented:
@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 Use the Help Bell

Need to boost the visibility of your question for solutions? Use the Experts Exchange Help Bell to confirm priority levels and contact subject-matter experts for question attention.  Check out this how-to article for more information.

  • 4
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now