Good morning everyone,
I'm trying to extract certain elements of data from a batch of XML files into a single worksheet.
At present I'm extracting 10 elements from the XML data and I've 10 loops.
The problem I'm encountering is that in any XML file there could me several instances of the same tag e.g. <roof>some data</roof> .... later on in the file <roof>details about a roof extension</roof>. This second data set I don't want.
Below is the (crude) code, I've attached my spreadsheet but can't seem to upload XML files.
Many thanks in advance for your help.
I'm trying to extract certain elements of data from a batch of XML files into a single worksheet.
At present I'm extracting 10 elements from the XML data and I've 10 loops.
The problem I'm encountering is that in any XML file there could me several instances of the same tag e.g. <roof>some data</roof> .... later on in the file <roof>details about a roof extension</roof>. This second data set I don't want.
Below is the (crude) code, I've attached my spreadsheet but can't seem to upload XML files.
Many thanks in advance for your help.
Code:
Function ExtractBetween(BTag As String, ETag As String, Data As String, StartPos As Long) As String
Dim intPosB As Integer
Dim intPosE As Integer
intPosB = InStr(StartPos, Data, BTag)
If intPosB > 0 Then
intPosE = InStr(intPosB + Len(BTag) + 1, Data, ETag)
If intPosE > 0 Then
StartPos = intPosE + Len(ETag)
ExtractBetween = Mid(Data, intPosB + Len(BTag), intPosE - intPosB - Len(BTag))
Else
StartPos = 0
ExtractBetween = ""
End If
Else
StartPos = 0
ExtractBetween = ""
End If
End Function
-------------------------------------
Sub CombineXMLFiles()
Dim strBeginTag As String
Dim strEndTag As String
Dim intUnit As Integer
Dim strBuf As String
Dim lngPos As Long
Dim row As Integer
Dim FileArray As Variant
FileArray = Application.GetOpenFilename(MultiSelect:=True)
If IsArray(FileArray) Then
For i = LBound(FileArray) To UBound(FileArray)
'Load the XML file contents as a string
strTargetFile = FileArray(i)
intUnit = FreeFile
Open strTargetFile For Input As intUnit
strBuf = Input(LOF(intUnit), #intUnit)
Close intUnit
'Write the source file name for tracking
'Sheet1.Cells(row + i, 1).Value = strTargetFile
'==========================================================
' Search the file for the 1st XML block - "Completion Date"
lngPos = 1
counter1 = 0
' Sheet1.Cells(row + i + 1, 1).Value = "<SAP:Completion-Date>"
Do
counter1 = counter1 + 1
strBeginTag = "<SAP:Completion-Date>"
strEndTag = "</SAP:Completion-Date>"
Sheet1.Cells(row + i + counter1, 1).Value = ExtractBetween(strBeginTag, strEndTag, strBuf, lngPos)
Loop While lngPos > 0
'==========================================================
'Search the file for the 2nd XML block - "RRN"
lngPos = 1
counter2 = 0
' Sheet1.Cells(row + i + 1, 2).Value = "<SAP:Report-Header>"
Do
counter2 = counter2 + 1
strBeginTag = "<HIP:RRN>"
strEndTag = "</HIP:RRN>"
Sheet1.Cells(row + i + counter2, 2).Value = ExtractBetween(strBeginTag, strEndTag, strBuf, lngPos)
Loop While lngPos > 0
'==========================================================
'Search the file for the 3rd XML block - "UPRN"
lngPos = 1
counter3 = 0
' Sheet1.Cells(row + i + 1, 3).Value = "<HIP:UPRN>"
Do
counter3 = counter3 + 1
strBeginTag = "<HIP:UPRN>"
strEndTag = "</HIP:UPRN>"
Sheet1.Cells(row + i + counter3, 3).Value = ExtractBetween(strBeginTag, strEndTag, strBuf, lngPos)
Loop While lngPos > 0
'==========================================================
'Search the file for the 4th XML block - "<Address-Line-1>"
lngPos = 1
counter4 = 0
' Sheet1.Cells(row + i + 1, 4).Value = "<Address-Line-1>"
Do
counter4 = counter4 + 1
strBeginTag = "<SAP:Property>"
strEndTag = "</HIP:Address-Line-1>"
Sheet1.Cells(row + i + counter4, 4).Value = ExtractBetween(strBeginTag, strEndTag, strBuf, lngPos)
Loop While lngPos > 0
'==========================================================
'Search the file for the 5th XML block - "<HIP:Post-Town>"
lngPos = 1
counter5 = 0
' Sheet1.Cells(row + i + 1, 5).Value = "<HIP:Post-Town>"
Do
counter5 = counter5 + 1
strBeginTag = "<SAP:Property>"
strEndTag = "</HIP:Post-Town>"
Sheet1.Cells(row + i + counter5, 5).Value = ExtractBetween(strBeginTag, strEndTag, strBuf, lngPos)
Loop While lngPos > 0
'===========================================================
'Search the file for the 6th XML block - "<HIP:Postcode>"
lngPos = 1
counter6 = 0
' Sheet1.Cells(row + i + 1, 6).Value = "<HIP:Postcode>"
Do
counter6 = counter6 + 1
strBeginTag = "<SAP:Property>"
strEndTag = "</HIP:Postcode>"
Sheet1.Cells(row + i + counter6, 6).Value = ExtractBetween(strBeginTag, strEndTag, strBuf, lngPos)
Loop While lngPos > 0
'===========================================================
'Search the file for the 7th XML block - "<HIP:Roof>"
lngPos = 1
counter7 = 0
' Sheet1.Cells(row + i + 1, 8).Value = "<HIP:Roof>"
Do
counter7 = counter7 + 1
strBeginTag = "<HIP:Roof>"
strEndTag = "</HIP:Description>"
Sheet1.Cells(row + i + counter7, 7).Value = ExtractBetween(strBeginTag, strEndTag, strBuf, lngPos)
Loop While lngPos > 0
'===========================================================
'Search the file for the 8th XML block - "<HIP:Wall>"
lngPos = 1
counter8 = 0
' Sheet1.Cells(row + i + 1, 8).Value = "<HIP:Wall>"
Do
counter8 = counter8 + 1
strBeginTag = "<HIP:Wall>"
strEndTag = "</HIP:Description>"
Sheet1.Cells(row + i + counter8, 8).Value = ExtractBetween(strBeginTag, strEndTag, strBuf, lngPos)
Loop While lngPos > 0
'===========================================================
'Search the file for the 8th XML block - "<HIP:Wall>"
lngPos = 1
counter9 = 0
' Sheet1.Cells(row + i + 1, 9).Value = "<HIP:Wall>"
Do
counter9 = counter9 + 1
strBeginTag = "<HIP:SAP-Building-Part>"
strEndTag = "</HIP:Construction-Age-Band>"
Sheet1.Cells(row + i + counter9, 9).Value = ExtractBetween(strBeginTag, strEndTag, strBuf, lngPos)
Loop While lngPos > 0
'============================================================
'Search the file for the 8th XML block - "<HIP:Wall>"
lngPos = 1
counter10 = 0
' Sheet1.Cells(row + i + 1, 10).Value = "<HIP:Wall>"
Do
counter10 = counter10 + 1
strBeginTag = "<HIP:Total-Floor-Area>"
strEndTag = "</HIP:Total-Floor-Area>"
Sheet1.Cells(row + i + counter10, 10).Value = ExtractBetween(strBeginTag, strEndTag, strBuf, lngPos)
Loop While lngPos > 0
' If counter1 > counter2 Then
' row = row + counter1
' Else
' row = row + counter2
' End If
Next i
Else
MsgBox "You clicked Cancel"
End If
End Sub
-----------------------------------
fdt="DCLG-HIP/BaseDataTypes" xmlns:bdt="DCLG-SAP09/BaseDataTypes" xmlns:SAP="DCLG-SAP" xmlns:SAP05="DCLG-SAP05" xmlns:SAP09="DCLG-SAP09" xmlns:xsi="