Export VBA to XML with a string containing "<"

Question

I need XML files created by VBA to contain "<" in a string. Currently VBA turns all instances of "<" into "&It;" as this characters is used for tags.

I believe something needs to added towards the end of the code to find and replace all instances of "&It;" to "<".

My Code

sTemplateXML = _
        " <movie>" + vbNewLine + _
        "   <plot/>" + vbNewLine + _
        "   <_outline/>" + vbNewLine + _
        "   <_lockdata/>" + vbNewLine + _
        "   <dateadded/>" + vbNewLine + _
        "   <title/>" + vbNewLine + _
        "   <rating/>" + vbNewLine + _
        "   <year/>" + vbNewLine + _
        "   <sorttile/>" + vbNewLine + _
        "   <mpaa/>" + vbNewLine + _
        "   <premiered/>" + vbNewLine + _
        "   <releasedate/>" + vbNewLine + _
        "   <runtime/>" + vbNewLine + _
        "   <studio/>" + vbNewLine + _
        "   <tag/>" + vbNewLine + _
        "   <actor/>" + vbNewLine + _
        " </movie>" + vbNewLine


 Set doc = CreateObject("MSXML2.DOMDocument")
 doc.async = False
 doc.validateOnParse = False
 doc.resolveExternals = False

With Sheets("Sheet3")
  lLastRow = .UsedRange.Rows.Count

 For lRow = 3 To lLastRow
   sFolder = .Cells(lRow, 677).Value
   sFile = .Cells(lRow, 678).Value
   sPlot = .Cells(lRow, 679).Value
   s_outline = .Cells(lRow, 680).Value
   s_lockdata = .Cells(lRow, 681).Value
   sDateadded = .Cells(lRow, 682).Value
   sTitle = .Cells(lRow, 683).Value
   sRating = .Cells(lRow, 684).Value
   sYear = .Cells(lRow, 685).Value
   sSorttile = .Cells(lRow, 686).Value
   sMpaa = .Cells(lRow, 687).Value
   sPremiered = .Cells(lRow, 688).Value
   sReleasedate = .Cells(lRow, 689).Value
   sRuntime = .Cells(lRow, 690).Value
   sStudio = .Cells(lRow, 691).Value
   sTag = .Cells(lRow, 692).Value
   sActor = .Cells(lRow, 693).Value

   doc.LoadXML sTemplateXML
   doc.getElementsByTagName("plot")(0).appendChild doc.createTextNode(sPlot)
   doc.getElementsByTagName("_outline")(0).appendChild doc.createTextNode(s_outline)
   doc.getElementsByTagName("_lockdata")(0).appendChild doc.createTextNode(s_lockdata)
   doc.getElementsByTagName("dateadded")(0).appendChild doc.createTextNode(sDateadded)
   doc.getElementsByTagName("title")(0).appendChild doc.createTextNode(sTitle)
   doc.getElementsByTagName("rating")(0).appendChild doc.createTextNode(sRating)
   doc.getElementsByTagName("year")(0).appendChild doc.createTextNode(sYear)
   doc.getElementsByTagName("sorttile")(0).appendChild doc.createTextNode(sSorttile)
   doc.getElementsByTagName("mpaa")(0).appendChild doc.createTextNode(sMpaa)
   doc.getElementsByTagName("premiered")(0).appendChild doc.createTextNode(sPremiered)
   doc.getElementsByTagName("releasedate")(0).appendChild doc.createTextNode(sReleasedate)
   doc.getElementsByTagName("runtime")(0).appendChild doc.createTextNode(sRuntime)
   doc.getElementsByTagName("studio")(0).appendChild doc.createTextNode(sStudio)
   doc.getElementsByTagName("tag")(0).appendChild doc.createTextNode(sTag)
   doc.getElementsByTagName("actor")(0).appendChild doc.createTextNode(sActor)
   doc.Save sFolder & sFile & ".nfo"
  Next
 
 End With

I've tried

• strXml = VBA.Replace(strXml, "&", "&") {before doc.save - no errors but nothing is corrected}

I've found examples of functions (How to write an ampersand to an XML file from an Excel file using VBA?) but I have no idea where to place the code.

I've updated my post to address the criticsms below.

Answer 1

I think the problem is that sActor contains tags so createTextNode(sActor) will encode the <'s. Unless you have some other reason to use MSXML2 objects I would suggest removing the tags from the data and building the xml more simply, for example

Sub CreateXMLfiles()

    Dim wb As Workbook, ws As Worksheet
    Dim tags, ar, t
    Dim iLastRow As Long, r As Long, n As Long
    Dim c As Integer, i As Integer, k As Integer
    Dim sFolder As String, sFile As String, s As String

    Dim fso, ts
    Set fso = CreateObject("Scripting.FilesystemObject")

    tags = Array("plot:679", "_outline:680", "_lockdata:681", "dateadded:682", "title:683", _
                "rating:684", "year:685", "sorttitle:686", "mpaa:687", "premiered:688", _
                "releasedate:689", "runtime:690", "studio:691", "tag:692", "actor,name:693")

    Set wb = ThisWorkbook
    Set ws = wb.Sheets("Sheet3")
    iLastRow = ws.UsedRange.Row + ws.UsedRange.Rows.Count - 1

    For r = 3 To iLastRow
        sFolder = wb.Path & "\" & ws.Cells(r, 677).Value & "\"
        sFile = ws.Cells(r, 678).Value
        If Len(sFile) > 0 Then
            s = "<?xml version=""1.0"" encoding=""UTF-8"" standalone=""yes""?>" _
                & vbLf & "<movie>" & vbLf
            For i = 0 To UBound(tags)
                ar = Split(tags(i), ":") 'tag,column
                c = ar(1) ' data column
                t = Split(ar(0), ",") ' tree
                s = s & Space(4)
                For k = 0 To UBound(t)
                    s = s & "<" & t(k) & ">"
                Next
                s = s & ws.Cells(r, c) ' value
                For k = UBound(t) To 0 Step -1
                    s = s & "</" & t(k) & ">"
                Next
                s = s & vbLf
            Next
            s = s & "</movie>"
            
            ' save to file
            Set ts = fso.createTextFile(sFolder & sFile & ".nfo", 1, 1) ' overwrite, unicode
            ts.write s
            ts.Close
            n = n + 1
         End If
    Next
    MsgBox n & " files created in " & sFolder, vbInformation

End Sub