Firstartemis
New Member
- Joined
- Jun 17, 2015
- Messages
- 10
Good Morning,
Thanks to the help of this board and google, I have been able to write the below macro in excel:
It reads a xml file and pastes the values in each cell. However, if the form is left blank it does not record the xml name and the results are no longer aligned. the XML file is below:
The opening and closing tags have been replaced with 'respectively.
How do I assign each field to a column so that the data does not become mismatched? Thank you for your help.</ids></xfdf></ids></xfdf></ids></xfdf>
Thanks to the help of this board and google, I have been able to write the below macro in excel:
Code:
Sub GetFormData()
Dim XDoc As MSXML2.DOMDocument
Dim xEmpDetails As MSXML2.IXMLDOMNode
Dim xEmployee As MSXML2.IXMLDOMNode
Dim xChild As MSXML2.IXMLDOMNode
Dim strFolder As String, strFile As String
Dim WkSht As Worksheet, i As Long, j As Long
strFolder = GetFolder
If strFolder = "" Then Exit Sub
Set WkSht = ActiveSheet
i = WkSht.Cells(WkSht.Rows.Count, 1).End(xlUp).Row
strFile = Dir(strFolder & "\*.xfdf", vbNormal)
While strFile <> ""
i = i + 1
Set XDoc = New MSXML2.DOMDocument
XDoc.async = False
XDoc.validateOnParse = False
XDoc.Load (strFolder & "\" & strFile)
Set xEmpDetails = XDoc.DocumentElement
Set xEmployee = xEmpDetails.FirstChild
j = 0
For Each xEmployee In xEmpDetails.ChildNodes
For Each xChild In xEmployee.ChildNodes
j = j + 1
WkSht.Cells(i, j) = xChild.Text
Next xChild
Next xEmployee
strFile = Dir()
Wend
Application.ScreenUpdating = True
Dim sht As Worksheet
Dim fnd As Variant
Dim rplc As Variant
fnd = "Off"
rplc = ""
For Each sht In ActiveWorkbook.Worksheets
sht.Cells.Replace what:=fnd, Replacement:=rplc, _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False
Next sht
fnd = "Please type your comments here:"
rplc = ""
For Each sht In ActiveWorkbook.Worksheets
sht.Cells.Replace what:=fnd, Replacement:=rplc, _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False
Next sht
ActiveSheet.Range("Table1[#All]").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5), Header:=xlYes
ThisWorkbook.RefreshAll
End Sub
Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").Browseforfolder(0, "Choose a folder ", 0) ''
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function
It reads a xml file and pastes the values in each cell. However, if the form is left blank it does not record the xml name and the results are no longer aligned. the XML file is below:
Code:
<!--?xml version="1.0" encoding="UTF-8"?-->
<xfdf xmlns="http://ns.adobe.com/xfdf/" xml:space="preserve"
`?xml version="1.0" encoding="UTF-8"?`
`xfdf xmlns="http://ns.adobe.com/xfdf/" xml:space="preserve"
``fields
``field name="1a"
``value
`Murdy`/value
``/field
``field name="1b"
``value
`William`/value
``/field
``field name="1c"
``value
`D`/value
``/field
``field name="1d"
``value
`E7`/value
``/field
``field name="1e"
``value
`william.murdy@fe.navy.mil`/value
``/field
``field name="1f"
``value
`315.243.8942`/value
``/field
``field name="1g"
``value
`61054`/value
``/field
``field name="1h"
``value
`N00R`/value
``/field
``field name="1i"
``value
`Division`/value
``/field
``field name="1j"
``value
`Off`/value
``/field
``field name="2a"
``value
`Christian`/value
``/field
``field name="3a"
``value
`Off`/value
``/field
``field name="4a"
``value
`Off`/value
``/field
``field name="4b"
``value
`Off`/value
``/field
``field name="5a"
``value
`Off`/value
``/field
``field name="5b"
``value
`Off`/value
``/field
``field name="5c"
``value
`X`/value
``/field
``field name="5d"
``value
`Off`/value
``/field
``field name="5e"
``value
`Off`/value
``/field
``field name="5f"
``field name="a"
``value
`Off`/value
``/field
``/field
``field name="6"
``field name="a"
``value
`Off`/value
``/field
``/field
``field name="7"
``field name="a"
``value
`Off`/value
``/field
``/field
``field name="8a"
``value
`Comment`/value
``/field
``field name="Email"
/``/fields
``ids original="4DB217719D02E13453645B52AEC2B833" modified="B07D15936F96F849BAA2AC2C90F7C2E6"
/``/xfdf
`<ids original="4DB217719D02E13453645B52AEC2B833" modified="B07D15936F96F849BAA2AC2C90F7C2E6"
<xfdf xmlns="http://ns.adobe.com/xfdf/" xml:space="preserve"
<ids original="4DB217719D02E13453645B52AEC2B833" modified="B07D15936F96F849BAA2AC2C90F7C2E6"
<xfdf xmlns="http://ns.adobe.com/xfdf/" xml:space="preserve"
<ids original="4DB217719D02E13453645B52AEC2B833" modified="B07D15936F96F849BAA2AC2C90F7C2E6"
How do I assign each field to a column so that the data does not become mismatched? Thank you for your help.</ids></xfdf></ids></xfdf></ids></xfdf>
Last edited: