Use VB to create Excel file from multiple XML files

[techadmin2012]

I have over 800 XML files in a directory. I need to read each file, extract 2 pieces of data from each and populate an excel spread sheet. One column is the first piece of data and column 2 is the second piece of data. Each XML file is only one line long.

Can anyone help me with this?

 

[xwb]

It will be something like this. Say your xml file looks like

<members>
  <member>
    <connectedto name="upper arm">body</connectedto> 
  </member>
</members>

I know you said your xml files are only one line long - it doesn't really matter as xml only has new lines for readability

The code will look something like this. The main problem is the pathnames. If you use relative pathnames, excel's is relative to My Documents, FSO and WShell are relative to the current directory.

' This needs to be the full filepath.
const excelFilename = "%AllUsersProfile%\Documents\xlextract\collate.xls"
' This also needs to be the full path.
const xmlRepository = "%AllUsersProfile%\Documents\xlextract"

' Get all the things we need
set objFSO = CreateObject ("Scripting.FileSystemObject")
set objExcel = CreateObject ("Excel.Application")
set objXML = CreateObject ("MSXML2.DOMDocument.6.0")
set objDOS = CreateObject ("WScript.Shell")

if isNull(g_objXML ) then
   ' Try version 5.  This is standard for XP
   set objXML  = CreateObject ("MSXML2.DOMDocument.5.0")
end if

' Create an excel spreadsheet
objExcel.Workbooks.Add
objExcel.Cells(1,1) = "Name"
objExcel.Cells(1,2) = "Connected To"

' Get all the XML files in the current directory
xmlRepositoryFull = objDOS.ExpandEnvironmentStrings(xmlRepository)
WScript.echo "Examining files in " & xmlRepositoryFull
set objDir = objFSO.GetFolder(xmlRepositoryFull)
objXML.validateOnParse = true
objXML.async = false
row = 1
for each file in objDir.Files
   if right(file.name, 4) = ".xml" then
      WScript.echo file.name
      objXML.load file.name
	  set taglist = objXML.getElementsByTagName ("connectedto")
      for each tag in taglist
         name = tag.getAttribute ("name")
         connect = tag.text
         WScript.echo name + "=" + connect         
         row = row + 1
         objExcel.Cells(row,1) = name
         objExcel.Cells(row,2) = connect
      next
   end if   
next

excelFilenameFull = objDOS.ExpandEnvironmentStrings(excelFilename)
on error resume next
WScript.Echo "Deleting " & excelFilenameFull & " if it exists"
objFSO.DeleteFile excelFilenameFull
WScript.Echo "Saving as " & excelFilenameFull
objExcel.ActiveWorkbook.SaveAs excelFilenameFull
objExcel.ActiveWorkbook.Close
objExcel.Quit

WScript.Quit

If it falls over, remember to go into task manager and delete the excel process that the script created. If you don't you could end up with a lot of excel processes in the background.

 

[techadmin2012]

Thanks for the help. This partially works. Here is what I have in each of my XML files. I need create a spreadsheet with headings for Invoice Response Number
Original Invoince Number
Status
Invoice Response reason Comments.

I need each column to then be populated from the data in each of these. I can't get the data to pull in. I have created the spreadsheet, added column headers and I can see that it is reading each file, but not pulling in the data.

- <ns0:InvoiceResponse xmlns:ns0="

http://Cortex.TotalSafety.TotalSafetyInvoiceResponse">

- <Header>
<Invoice_Response_Number>453640</Invoice_Response_Number>
<Original_Invoice_Number>453640</Original_Invoice_Number>
<Status_Code>RECEIVED</Status_Code>
</Header>
</ns0:InvoiceResponse>

 

[techadmin2012]

I found a solution and it is pretty simple. Simply create a macro:

Sub xmlImport()

fld = "c:\cortex\inbound\"
i = 2
found = False
fil = Dir(fld & "*.xml")
Do While (fil <> "")
found = False
Location = fld & fil
ActiveWorkbook.xmlImport URL:=Location, ImportMap:=Nothing, Overwrite:=True, Destination:=Range("$A" & i)
Do
If Cells(i, 2) = "" Then
found = True
Else
i = i + 1
End If
Loop Until found
fil = Dir
Loop
End Sub