XML substitution of values

[mdhont]

Dear all,

I'm currently working on a VBA tool in which I would like to generate multiple duplicates of the same XML-files. The aim is to replace some values each time a new XML-file is created. These files serve then in a later stage to call another software programme.

However, I faced some problems with the unicode type of strings. My current code is given below.
First I'm reading the base XML-file in the DO-loop into 'sin', afterwards I search for the location of the value of the particular variables I want to change. These values are always written between double quotes, so I would like to change everything in between the double quotes.

However, the current results returns a lot of useless symbols. I'm sure there must exist a more efficient way to deal with this, anyone who could help me out?

Cheers,
M

_______

Sub ParseVarValues(XmlFile_IN As String, XmlFile_OUT As String)
Dim i As Integer, j As Integer, Index1 As Integer, Index2 As Integer, Index3 As Integer, Index4 As Integer
Dim sin As String, sout As String, line As String, ToReplace As String
Dim fin As Object, fout As Object


Set fin = fs.OpenTextFile(XmlFile_IN, ForReading, TristateUseDefault)
sin = ""


Do
line = fin.Read(1)
sin = sin + line
Loop Until fin.AtEndOfStream

fin.Close

For i = 1 To VarTotal
Index1 = InStr(1, sin, StrConv("p0 v=" & Chr(34) & VarName(i), vbUnicode)) 'Search the section about the particular variable
Index2 = InStr(Index1 + 1, sin, StrConv("p0 v=", vbUnicode)) 'Search the starting index of the place where the value is specified
Index3 = InStr(Index2 + 1, sin, StrConv(Chr(34), vbUnicode)) 'Search the starting index of the place where the value is specified
Index4 = InStr(Index3 + 1, sin, StrConv(Chr(34), vbUnicode)) 'Search the ending index of the place where the value is specified


ToReplace = Mid(sin, Index3 + 2, Index4 - Index3 - 1) 'Double qoute takes to indices in unicode
sout = Left(sin, Index3 + 1) & Replace(ToReplace, ToReplace, StrConv(VarValue(i), vbUnicode)) & Right(sin, Len(sin) - (Index4 - 2))
Next i


Set fout = fs.CreateTextFile(XmlFile_OUT, True, False) 'overwrite if the file already exists and no unicode
fout.Write (sout)
fout.Close


End Sub


______
Example of the original and the result in attachment: Input.xml and Output.xml.002

 

[snb]

- het is prettig als je je vraag in het Nederlands stelt
- zet VBA code immer tussen code tags; zie https://www.helpmij.nl/forum/announcement.php?f=348
- het is praktisch als je voorbeeld files plaatst; zie: https://www.helpmij.nl/forum/announcement.php?f=348
- en natuurlijk niet Quoten/citeren; zie https://www.helpmij.nl/forum/announcement.php?f=348

 

[mdhont]

- het is prettig als je je vraag in het Nederlands stelt
- zet VBA code immer tussen code tags; zie https://www.helpmij.nl/forum/announcement.php?f=348
- het is praktisch als je voorbeeld files plaatst; zie: https://www.helpmij.nl/forum/announcement.php?f=348

Mijn excuses, ik zal hieraan denken bij het posten van een volgend bericht. Het huidige bericht is blijkbaar niet mogelijk?

 

[snb]

Je kun je bericht gewoon aanpassen met de editor van dit forum.
Een XML betand toevoegen kan daar ook: paperclip
En geef aan welke wijziging aangebracht moet worden in het bestand.

Sub M_snb()
   c00=createobject("scripting.filesystemobject").opentextfile("G:\OF\voorbeeld.XML").readall

   sn=filter(split(c00,vbcrlf),"<p0 v=")
   for j=0 to ubound(sn)
      c00=replace(c00,sn(j),"iets anders"
   next
End Sub

 

[mdhont]

Bedankt voor de respons. De functie readall lijkt me echter niet te werken. Als ik de ingelezen data (zonder modificatie terug wil wegschrijven, krijg ik een foutmelding.)

U kunt m'n bestanden vinden in bijlage.

M

 

[snb]

Gebruik:

Sub M_snb()
    ActiveWorkbook.XmlImport "G:\Input.xml", Nothing, -1, Cells(1)
End Sub