Compiling Multiple XML Workbooks

[Woody19722]

:banghead: This is giving me a hard time. I know how to combine multiple worksheets from multiple wookbooks into one .xls worksheet. Now I am tring to combine data that is stored as a .xml onto one worksheet. If someone could guide me to some code I might be able to figure it out. Thank you.

[Oorang]

Hi Woody,
Welcome to the board. This is just off of the cuff, and I am sure it could be improved... Each xml file has a "inner portion" (as it were) that will be just the worksheet data. You could read each file in, strip out everything but the worksheet portion and keep adding them together. Once you have all the worksheet data you could just sandwich them in the workbook header info and call it a day. A rough framework would be something like this:
Option Explicit

Public Sub test()
Const strTargetFldr_c As String = "C:\Test\"
Const strPathOut_c As String = "C:\Test\Output.xml"
Dim fso As Scripting.FileSystemObject
Dim fldr As Scripting.Folder
Dim ts As Scripting.TextStream
Dim fl As Scripting.File
Dim strFileText As String
Dim strBigOutput As String
Set fso = New Scripting.FileSystemObject
Set fldr = fso.GetFolder(strTargetFldr_c)
For Each fl In fldr.Files
If Right$(fl.Name, 4) = ".xml" Then
strFileText = fl.OpenAsTextStream(ForReading).ReadAll
'do something to remove the workbook header footers.
'Then append just the worksheet portions to the variable.
strBigOutput = strBigOutput & strFileText
End If
Next
Set ts = fso.CreateTextFile(strPathOut_c, True, True)
ts.Write strBigOutput
ts.Close
End Sub

I'd suggest that you go download XML Notepad 2007 (http://www.microsoft.com/downloads/details.aspx?familyid=72d6aa49-787d-4118-ba5f-4f30fe913628&displaylang=en) from Microsoft. It's free and should help you be able to visualize the file structure a little easier as you explore the parts you need to save/throw away.

[Woody19722]

Thank you very much. I will give it a try.

[Woody19722]

Well I have tried different scenarios but can't get it to work. I have placed the compiler in the same folder with the files and here is an example of the name convention for the files, 3522_P4W2_Schedule.xml, 3533_P4W2_schedule.xml, etc....

Also these XML workbooks have headers. How do I skip over them to collect the data below?

I don't know if I am reading the code wrong but I am still kind of new at coding VB.

Thanks....

[Oorang]

Hi Woody,
No worries, we can get to the bottom of it. I suspect we can solve this with the MSXML library but I have a few questions:
"Headers" could refer to a few things (ex: XML "Header" tag, "Header/Footer" header, file header etc). Could you clarify what you meant?
Worksheet names could be duplicated across multiple workbooks, did you have a (re)naming method in mind?
Will the cells contain raw data or could they also be formulas?
Finally, when you say "XML, could you confirm you mean the "XML Spreadsheet" format you save a file in from Excel?
Do we care about formatting? (I ask because this could complicate the task.)
Did you want all worksheets in one workbook, or all worksheets in all workbooks in one worksheet? (If you want the second then are all worksheets in the same format?

[Oorang]

As a temporary solution you could do something like what I have posted below. I'm not sure how well it will scale but by opening open the workbooks in excel and then adding the worksheets (as opposed to doing it via MSXML) the reference/renaming/style issues are solved automatically by Excel.

Option Explicit
Option Base 0

Public Sub Example()
Const strSavePath_c As String = _
"C:\Test\compiled.xml"
CompileXMLWorkbooks "C:\Test\XML", strSavePath_c
End Sub

Public Sub CompileXMLWorkbooks(ByVal folderPath As String, ByVal saveAs As String)
Dim fso As Scripting.FileSystemObject
Dim fldr As Scripting.Folder
Dim fl As Scripting.File
Dim wbNew As Excel.Workbook
Dim wb As Excel.Workbook
Dim blnComplete As Boolean
On Error GoTo Err_Hnd
LockInterface True
Set fso = New Scripting.FileSystemObject
Set fldr = fso.GetFolder(folderPath)
For Each fl In fldr.Files
'Only review XML documents:
If LCase$(Right$(fl.Name, 4&) = ".xml") Then
Set wb = Excel.Workbooks.Open(fl.path, False, True)
If wbNew Is Nothing Then
Set wbNew = wb
Else
wb.Sheets.Move After:=wbNew.Sheets(wbNew.Sheets.Count)
End If
End If
Next
wbNew.saveAs saveAs, xlXMLSpreadsheet
blnComplete = True
MsgBox "Done"
Exit_Proc:
On Error Resume Next
If Not blnComplete Then
wbNew.Close False
End If
LockInterface False

Exit Sub
Err_Hnd:
'Load error'd return value into return value variable.
MsgBox Err.Description, vbCritical, "Error: " & Err.Number
Resume Exit_Proc
Resume
End Sub

Public Sub LockInterface(ByVal lockOn As Boolean)
Dim blnVal As Boolean
Static blnOrgWIT As Boolean
With Excel.Application
If lockOn Then
blnVal = False
blnOrgWIT = .ShowWindowsInTaskbar
.ShowWindowsInTaskbar = False
Else
blnVal = True
.ShowWindowsInTaskbar = blnOrgWIT
End If
.DisplayAlerts = blnVal
.EnableEvents = blnVal
.ScreenUpdating = blnVal
.Cursor = IIf(blnVal, xlDefault, xlWait)
.EnableCancelKey = IIf(blnVal, xlInterrupt, xlErrorHandler)
End With
End Sub