Reading XML file via VBA

nishit dey

I am trying to read a XML file (this is not in a correct format). Below is the actual XML file that I have.

<?xml version="1.0" encoding="UTF-8"?><Report time="8/18/2017 12:54:42"><Table>TABLE</Table><Application>Fruits</Application><Environment>AMAZON</Environment><Group>FOREST</Group><SubGroup>RAINFOREST</SubGroup><Row>3</Row><Release>SEPT</Release><Result>Pass</Result><Testname>HEALTHCHECK</Testname><Screenshotpath>C:\PracSession\ABC.png"</Screenshotpath></Report>

Now I am trying to read this and save the XML format, but unable to get any further.

Format that I want and save it:

<?xml version="1.0" encoding="UTF-8"?>
<Report time="8/18/2017 12:54:42">
<Table>TABLE</Table>
<Application>Fruits</Application>
<Environment>AMAZON</Environment>
<Group>FOREST</Group>
<SubGroup>RAINFOREST</SubGroup>
<Row>3</Row>
<Release>SEPT</Release>
<Result>Pass</Result>
<Testname>HEALTHCHECK</Testname>
<Screenshotpath>C:\PracSession\ABC.png"</Screenshotpath>
</Report>

I am able to check the format but not able to save it. Below is the code that I have tried.

Public Sub Create_Report()
myFile = "C:\Prac_Session\OLB.xml"
Dim fso As FileSystemObject: Set fso = New FileSystemObject
Set txtStream = fso.OpenTextFile(myFile, ForReading, False)
Do While Not txtStream.AtEndOfStream
    Debug.Print txtStream.ReadLine
    Tempstr = ">" & vbNewLine & "<"
    a = Replace(txtStream.ReadLine, "><", Tempstr)
    Debug.Print a
    ''Now to save.??''
Loop
txtStream.Close

End Sub

Xabier

I believe this would do it:

Sub foo()
Dim objFSO
Const ForReading = 1
Const ForWriting = 2
Dim objTS 'define a TextStream object
Dim strContents As String
Dim fileSpec As String

fileSpec = "C:\Prac_Session\OLB.xml" 'change the path to whatever yours ought to be
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTS = objFSO.OpenTextFile(fileSpec, ForReading)

strContents = objTS.ReadAll 'would use read all to read the whole file into memory

'Do While Not objTS.AtEndOfStream
'    strContents = strContents & " " & objTS.ReadLine 'Read line by line and store all lines in strContents
'Loop
Tempstr = ">" & vbCrLf & "<" 'instead of vbNewLine
strContents = Replace(strContents, "><", Tempstr)
objTS.Close

Set objTS = objFSO.OpenTextFile(fileSpec, ForWriting)
objTS.Write strContents
objTS.Close
End Sub

Collected from the Internet

Please contact [email protected] to delete if infringement.