Trying to create a new XML document for each row in Excel worksheet

Question

I'm trying to create a separate XML document for each row in an Excel file. Row 1 lists the tag names, and Column A identifies the document title for each row.

I'm fairly inexperienced when it comes to VBA, but this is what I've managed to come up with so far based on multiple answers to similar questions.

Sub testXLStoXML()

sTemplateXML = _
                                  "<?xml version='1.0'?>" + vbNewLine + _
                                  "<mods xmlns='http://www.loc.gov/mods/v3' xmlns:mods='http://www.loc.gov/mods/v3' xmlns:xsi='http://www.w3.org/2001/XMLSchema-instance' xmlns:xlink='http://www.w3.org/1999/xlink'>" + vbNewLine + _
    sTemplateXML & "               <titleInfo>" + vbNewLine + _
    sTemplateXML & "                   <title>" + vbNewLine + _
    sTemplateXML & "                   </title>" + vbNewLine + _
    sTemplateXML & "               </titleInfo>" + vbNewLine + _
    sTemplateXML = sTemplateXML & "<titleInfo>" + vbNewLine
    sTemplateXML = sTemplateXML & "   <titleInfo>" + vbNewLine
    sTemplateXML = sTemplateXML & "   </titleInfo>" + vbNewLine
    sTemplateXML = sTemplateXML & "</titleInfo>" + vbNewLine + _
    sTemplateXML & "               <name type='personal'>" + vbNewLine + _
    sTemplateXML & "                  <namePart>" + vbNewLine + _
    sTemplateXML & "                  </namePart>" + vbNewLine + _
    sTemplateXML & "                  <role>" + vbNewLine + _
    sTemplateXML & "                     <roleTerm authority='marcrelator' type='text'>" + vbNewLine + _
    sTemplateXML & "                     </roleTerm>" + vbNewLine + _
    sTemplateXML & "                  </role>" + vbNewLine + _
    sTemplateXML & "               </name>" + vbNewLine + _
    sTemplateXML = sTemplateXML & "<name type='personal'>" + vbNewLine
    sTemplateXML = sTemplateXML & "   <namePart>" + vbNewLine
    sTemplateXML = sTemplateXML & "   </namePart>" + vbNewLine
    sTemplateXML = sTemplateXML & "   <role>" + vbNewLine
    sTemplateXML = sTemplateXML & "      <roleTerm authority='marcrelator' type='text'>" + vbNewLine
    sTemplateXML = sTemplateXML & "      </roleTerm>" + vbNewLine
    sTemplateXML = sTemplateXML & "   </role>" + vbNewLine
    sTemplateXML = sTemplateXML & "</name>" + vbNewLine + _
    sTemplateXML & "               <typeOfResource>text</typeOfResource>" + vbNewLine + _
    sTemplateXML & "               <genre authority='lctgm'>" + vbNewLine + _
    sTemplateXML & "               </genre>" + vbNewLine + _
    sTemplateXML & "               <language>" + vbNewLine + _
    sTemplateXML & "                  <name>" + vbNewLine + _
    sTemplateXML & "                    <language>" + vbNewLine + _
    sTemplateXML & "                        <languageTerm authority='iso639-2b' type='code'>" + vbNewLine + _
    sTemplateXML & "                        </languageTerm>" + vbNewLine + _
    sTemplateXML & "                    </language>" + vbNewLine + _
    sTemplateXML & "                  </name>" + vbNewLine + _
    sTemplateXML & "               </language>" + vbNewLine + _
    sTemplateXML = sTemplateXML & "<abstract>" + vbNewLine
    sTemplateXML = sTemplateXML & "</abstract>" + vbNewLine
    sTemplateXML = sTemplateXML & "<subject>" + vbNewLine
    sTemplateXML = sTemplateXML & "   <topic>" + vbNewLine
    sTemplateXML = sTemplateXML & "   </topic>" + vbNewLine
    sTemplateXML = sTemplateXML & "   <topic>" + vbNewLine
    sTemplateXML = sTemplateXML & "   </topic>" + vbNewLine
    sTemplateXML = sTemplateXML & "   <topic>" + vbNewLine
    sTemplateXML = sTemplateXML & "   </topic>" + vbNewLine
    sTemplateXML = sTemplateXML & "   <topic>" + vbNewLine
    sTemplateXML = sTemplateXML & "   </topic>" + vbNewLine
    sTemplateXML = sTemplateXML & "   <topic>" + vbNewLine
    sTemplateXML = sTemplateXML & "   </topic>" + vbNewLine
    sTemplateXML = sTemplateXML & "   <topic>" + vbNewLine
    sTemplateXML = sTemplateXML & "   </topic>" + vbNewLine
    sTemplateXML = sTemplateXML & "   <topic>" + vbNewLine
    sTemplateXML = sTemplateXML & "   </topic>" + vbNewLine
    sTemplateXML = sTemplateXML & "   <topic>" + vbNewLine
    sTemplateXML = sTemplateXML & "   </topic>" + vbNewLine
    sTemplateXML = sTemplateXML & "   <topic>" + vbNewLine
    sTemplateXML = sTemplateXML & "   </topic>" + vbNewLine
    sTemplateXML = sTemplateXML & "   <geographic>" + vbNewLine
    sTemplateXML = sTemplateXML & "   </geographic>" + vbNewLine
    sTemplateXML = sTemplateXML & "   <geographic>" + vbNewLine
    sTemplateXML = sTemplateXML & "   </geographic>" + vbNewLine
    sTemplateXML = sTemplateXML & "   <geographic>" + vbNewLine
    sTemplateXML = sTemplateXML & "   </geographic>" + vbNewLine
    sTemplateXML = sTemplateXML & "   <temporal>" + vbNewLine
    sTemplateXML = sTemplateXML & "   </temporal>" + vbNewLine
    sTemplateXML = sTemplateXML & "</subject>" + vbNewLine + _
    sTemplateXML & "               <relatedItem>" + vbNewLine + _
    sTemplateXML & "                  <titleInfo>" + vbNewLine + _
    sTemplateXML & "                     <title>" + vbNewLine + _
    sTemplateXML & "                     </title>" + vbNewLine + _
    sTemplateXML & "                  </titleInfo>" + vbNewLine + _
    sTemplateXML & "                  <name type='personal'>" + vbNewLine + _
    sTemplateXML & "                     <namePart>" + vbNewLine + _
    sTemplateXML & "                     </namePart>" + vbNewLine + _
    sTemplateXML & "                     <role>" + vbNewLine + _
    sTemplateXML & "                        <roleTerm authority='marcrelator' type='text'>" + vbNewLine + _
    sTemplateXML & "                        </roleTerm>" + vbNewLine + _
    sTemplateXML & "                     </role>" + vbNewLine + _
    sTemplateXML & "                  </name>" + vbNewLine + _
    sTemplateXML & "                  <name type='personal'>" + vbNewLine + _
    sTemplateXML & "                     <namePart>" + vbNewLine + _
    sTemplateXML & "                     </namePart>" + vbNewLine + _
    sTemplateXML & "                     <role>" + vbNewLine + _
    sTemplateXML & "                        <roleTerm authority='marcrelator' type='text'>" + vbNewLine + _
    sTemplateXML & "                        </roleTerm>" + vbNewLine + _
    sTemplateXML & "                     </role>" + vbNewLine + _
    sTemplateXML & "                  </name>" + vbNewLine + _
    sTemplateXML = sTemplateXML & "   <originInfo>" + vbNewLine
    sTemplateXML = sTemplateXML & "      <place>" + vbNewLine
    sTemplateXML = sTemplateXML & "         <placeTerm type='text'>" + vbNewLine
    sTemplateXML = sTemplateXML & "         </placeTerm>" + vbNewLine
    sTemplateXML = sTemplateXML & "      </place>" + vbNewLine
    sTemplateXML = sTemplateXML & "      <publisher>" + vbNewLine
    sTemplateXML = sTemplateXML & "      </publisher>" + vbNewLine
    sTemplateXML = sTemplateXML & "      <dateIssued>" + vbNewLine
    sTemplateXML = sTemplateXML & "      </dateIssued>" + vbNewLine
    sTemplateXML = sTemplateXML & "      <place>" + vbNewLine
    sTemplateXML = sTemplateXML & "         <placeTerm authority='marccountry' type='code'>" + vbNewLine
    sTemplateXML = sTemplateXML & "         </placeTerm>" + vbNewLine
    sTemplateXML = sTemplateXML & "      </place>" + vbNewLine
    sTemplateXML = sTemplateXML & "   </originInfo>" + vbNewLine + _
    sTemplateXML & "                  <language>" + vbNewLine + _
    sTemplateXML & "                     <language>" + vbNewLine + _
    sTemplateXML & "                        <languageTerm authority='iso639-2b' type='code'>" + vbNewLine + _
    sTemplateXML & "                        </languageTerm>" + vbNewLine + _
    sTemplateXML & "                     </language>" + vbNewLine + _
    sTemplateXML & "                  </language>" + vbNewLine + _
    sTemplateXML = sTemplateXML & "   <note>" + vbNewLine
    sTemplateXML = sTemplateXML & "   </note>" + vbNewLine
    sTemplateXML = sTemplateXML & "   <physicalDescription>" + vbNewLine
    sTemplateXML = sTemplateXML & "      <extent>" + vbNewLine
    sTemplateXML = sTemplateXML & "      </extent>" + vbNewLine
    sTemplateXML = sTemplateXML & "   </physicalDescription>" + vbNewLine
    sTemplateXML = sTemplateXML & "   <location>" + vbNewLine
    sTemplateXML = sTemplateXML & "      <physicalLocation>" + vbNewLine
    sTemplateXML = sTemplateXML & "      </physicalLocation>" + vbNewLine
    sTemplateXML = sTemplateXML & "   </location>" + vbNewLine
    sTemplateXML = sTemplateXML & "</relatedItem>" + vbNewLine + _
    sTemplateXML & "               </mods>"



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

 With ActiveWorkbook.Worksheets(1)
  lLastRow = .UsedRange.Rows.Count
  
  
  For lRow = 2 To lLastRow
   Dim sFile As String
   Dim sTitle As String
   Dim sTitleInfo As String
   Dim sNamePart As String
   Dim sRoleTerm As String
   Dim sNamePart2 As String
   Dim sRoleTerm2 As String
   
   sFile = "C:\Users\Duck\Documents\Batch Ingest\XML\" & Cells(lRow, 1).Value & ".xml"
   sTitle = .Cells(lRow, 2).Text
   sTitleInfo = .Cells(lRow, 3).Text
   sNamePart = .Cells(lRow, 5).Text
   sRoleTerm = .Cells(lRow, 6).Text
   sNamePart2 = .Cells(lRow, 8).Text
   sRoleTerm2 = .Cells(lRow, 9).Text
   doc.LoadXML sTemplateXML
   doc.getElementsByTagName("title")(0).appendChild doc.createTextNode(sTitle)
   doc.getElementsByTagName("titleinfo")(0).appendChild doc.createTextNode(sTitleInfo)
   doc.getElementsByTagName("namepart")(0).appendChild doc.createTextNode(sNamePart)
   doc.getElementsByTagName("roleterm")(0).appendChild doc.createTextNode(sRoleTerm)
   doc.getElementsByTagName("namepart")(0).appendChild doc.createTextNode(sNamePart2)
   doc.getElementsByTagName("roleterm")(0).appendChild doc.createTextNode(sRoleTerm2)
   doc.Save sFile
  Next

 End With
End Sub

I haven't finished the "GetElementsByTagName" part yet, because that part is causing the issue. For the following line, I get the error "Object variable or With block variable not set".

doc.getElementsByTagName("title")(0).appendChild doc.createTextNode(sTitle)

I know it probably isn't the most elegant, but based on what I've read, it should work correctly for XML with more than 25 lines (the limit on consecutive 'vbNewLine' constants).

I would appreciate some guidance on where I've erred, or any suggestions on a better method.

Update: I've decided to pursue a different method, and it has been far more successful. However, I'm still encountering one issue. Here is what I have:

Sub FSOCreateXMLFile()

Dim FSO As Object
Dim TextFile As Object
Dim CellData As String
Dim FilePath As String
Dim wb As Workbook
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim Template As Range
Dim Cell As Range

Set wb = Application.Workbooks("1897-springer-01 linked table.xlsm")
Set ws1 = wb.Worksheets("1897-springer-01")
Set ws2 = wb.Worksheets("Sheet1")
lLastRow = ws1.UsedRange.Rows.Count

Application.ScreenUpdating = False
Application.EnableEvents = False


'---------WRITE ROW TO TEMPLATE-------------

For lRow = 2 To lLastRow
    ws1.Cells(lRow, 2).Copy ws2.Range("B4")
    ws1.Cells(lRow, 3).Copy ws2.Range("B7")
    ws1.Cells(lRow, 5).Copy ws2.Range("B10")
    ws1.Cells(lRow, 6).Copy ws2.Range("B12")
    ws1.Cells(lRow, 8).Copy ws2.Range("B16")
    ws1.Cells(lRow, 9).Copy ws2.Range("B18")
    ws1.Cells(lRow, 11).Copy ws2.Range("B22")
    ws1.Cells(lRow, 12).Copy ws2.Range("B26")
    ws1.Cells(lRow, 13).Copy ws2.Range("B30")
    ws1.Cells(lRow, 14).Copy ws2.Range("B32")
    ws1.Cells(lRow, 15).Copy ws2.Range("B33")
    ws1.Cells(lRow, 16).Copy ws2.Range("B34")
    ws1.Cells(lRow, 17).Copy ws2.Range("B35")
    ws1.Cells(lRow, 18).Copy ws2.Range("B36")
    ws1.Cells(lRow, 19).Copy ws2.Range("B37")
    ws1.Cells(lRow, 20).Copy ws2.Range("B38")
    ws1.Cells(lRow, 21).Copy ws2.Range("B39")
    ws1.Cells(lRow, 22).Copy ws2.Range("B40")
    ws1.Cells(lRow, 23).Copy ws2.Range("B41")
    ws1.Cells(lRow, 24).Copy ws2.Range("B42")
    ws1.Cells(lRow, 25).Copy ws2.Range("B43")
    ws1.Cells(lRow, 26).Copy ws2.Range("B44")
    ws1.Cells(lRow, 27).Copy ws2.Range("B48")
    ws1.Cells(lRow, 29).Copy ws2.Range("B51")
    ws1.Cells(lRow, 30).Copy ws2.Range("B53")
    ws1.Cells(lRow, 32).Copy ws2.Range("B57")
    ws1.Cells(lRow, 33).Copy ws2.Range("B59")
    ws1.Cells(lRow, 34).Copy ws2.Range("B64")
    ws1.Cells(lRow, 35).Copy ws2.Range("B66")
    ws1.Cells(lRow, 36).Copy ws2.Range("B67")
    ws1.Cells(lRow, 37).Copy ws2.Range("B69")
    ws1.Cells(lRow, 38).Copy ws2.Range("B74")
    ws1.Cells(lRow, 39).Copy ws2.Range("B77")
    ws1.Cells(lRow, 40).Copy ws2.Range("B79")
    ws1.Cells(lRow, 41).Copy ws2.Range("B82")

'--------------CREATE BLANK XML FILE-----------------

  Set FSO = CreateObject("Scripting.FileSystemObject")
  Set TextFile = FSO.CreateTextFile("C:\MyFilePath\" & ws1.Cells(lRow, 1) & ".xml")
    TextFile.Close

  Application.Wait (Now + TimeValue("0:00:02"))

'------------PRINT TEMPLATE TO XML FILE---------------

  FilePath = "C:\MyFilePath\" & ws1.Cells(lRow, 1) & ".xml"
  Set Template = ws2.Range("R1:R85")
  CellData = ""
  
  Open FilePath For Output As #1

  For Each Cell In Template
      CellData = CellData + Cell.Value
        Print #1, CellData
      CellData = ""
  Next Cell
  Close #1
    
'-----------LOOP XML FILES UNTIL LAST ROW--------------

Next lRow

Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub

The first section copies specific cells from a given row on ws1 to specific cells on ws2 (which is structured like the desired XML file). The second section creates a blank XML file, the title of which is based on the value in column A for the current row. The last section opens the XML file and prints the desired range from ws2. It then loops to the next row in ws1. This works perfectly for the first row, returning the correct format and content in the XML.

In subsequent rows, the cells are correctly copied to ws2, and the title of the new XML file is taken from the correct cell in ws1 column A.

The issue arises when printing from ws2 to the XML. Instead of printing the specified range in ws2, it prints the row from ws1. (Oddly enough, it only prints the row up to column L before closing the XML and moving to the next row.)

I have tried multiple ways of writing the For Each statement, but all formulations return either the same result or blank files for all rows. Can anyone see the cause of the issue?

Thanks!

Final Update:

Finally figured it out -- it was an issue with the data. One of the cells in row 3 used curly quotes instead of straight quotes. I guess this caused the macro to read it incorrectly.

Thanks for the help folks!

tl;dr Your string assignment to `sTemplateXML` is a holy mess and doesn't correspond to what you told about 25 code line limits. First step: Check the string results (e.g. via `Debug.Print sTemplateXML` to the VB Editor's immediate window) and edit correct assignments (preferrably via a separate function call) as you added multiple new assignments to **prior** code lines via underscore `_` instead of beginning a separate code line when there occurs `sTemplateXML = sTemplateXML & <... /> ...`. — T.M., May 30 '21 at 18:56
After you sort out the template, the next problem will be with `getElementsByTagName` not working because of the namespaces. see [here](https://stackoverflow.com/questions/58026296) for details. — CDP1802, Jun 01 '21 at 08:30
You are filling column "B" on the template but printing column "R" so are there formulas in "R" ? — CDP1802, Jul 05 '21 at 10:08
Sorry, yes. I concatenate columns A, B, and C in column R. I find this makes the code look a bit cleaner. Using the original range (A1:C85) would be possible too, but the only way I could get it to work was by adding an extra For loop. — Justin, Jul 05 '21 at 18:09

score 1 · Answer 1 · answered May 30 '21 at 18:53

Your XML document is corrupted at the very beginning, so the required tags are not found, hence the error. Сontent of sTemplateXML variable after running your code:

False   </note>
   <physicalDescription>
      <extent>
      </extent>
   </physicalDescription>
   <location>
      <physicalLocation>
      </physicalLocation>
   </location>
</relatedItem>
False   </note>
   <physicalDescription>
      <extent>
      </extent>
   </physicalDescription>
   <location>
      <physicalLocation>
      </physicalLocation>
   </location>
               </mods>

For debugging, print the sTemplateXML value after generating it with Debug.Print sTemplateXML or output to the text file:

   fn = FreeFile
   Open "test.txt" For Output As #fn
   Print #1, sTemplateXML
   Close #fn

One of the reasons for errors during sTemplateXML generation is incorrect line breaks, for example, in lines 9 and 10:

sTemplateXML = _
                                  "<?xml version='1.0'?>" + vbNewLine + _
                                  "<mods xmlns='http://www.loc.gov/mods/v3' xmlns:mods='http://www.loc.gov/mods/v3' xmlns:xsi='http://www.w3.org/2001/XMLSchema-instance' xmlns:xlink='http://www.w3.org/1999/xlink'>" + vbNewLine + _
    sTemplateXML & "               <titleInfo>" + vbNewLine + _
    sTemplateXML & "                   <title>" + vbNewLine + _
    sTemplateXML & "                   </title>" + vbNewLine + _
    sTemplateXML & "               </titleInfo>" + vbNewLine + _
    sTemplateXML = sTemplateXML & "<titleInfo>" + vbNewLine

The last line is interpreted as a comparison ...+ _ sTemplateXML = sTemplateXML &... and produces the first False in the output

Thank you for the feedback! And sorry for the delayed response, this was my first question here and I forgot to check on it. After some thought, I think there are too many problems with this method and decided to proceed with a different one, which is working **almost** perfectly. I'll add my new code to the original post and an explanation of the issue (hopefully simpler to address). — Justin, Jul 04 '21 at 20:32

score 0 · Accepted Answer · answered Jul 05 '21 at 10:32

0

There is no need to create a blank file first, use the TextStream object to create and write to the file.

'--------------PRINT TEMPLATE TO XML FILE FILE-----------------
    
       Set FSO = CreateObject("Scripting.FileSystemObject") ' put this before entering loop
       Set TextFile = FSO.CreateTextFile("C:\MyFilePath\" & ws1.Cells(lRow, 1) & ".xml")
      
       Dim ar
       ar = Application.Transpose(ws2.Range("R1:R85")) ' should this be B1:B85 ?
       TextFile.writeLine Join(ar, vbCrLf) 
       TextFile.Close

answered Jul 05 '21 at 10:32

CDP1802

13,871
2
7
17

Thank you, will test this shortly and report back with the results. – Justin Jul 05 '21 at 18:26
@Justin Your code worked OK for me using col B so maybe the problem is with the template – CDP1802 Jul 05 '21 at 18:31
I just tried the above solution and got the same result -- works correctly for the first loop (lRow = 2), but subsequent files just contain the row from ws1 up to column L. The template is literally just opening/closing XML tags hardcoded into columns A and C. A few fixed values are hardcoded in column B. I just tried changing `For lRow = 2 to lLastRow` to `For lRow = 3 to lLastRow` , it doesn't work -- it only generates the correct XML for row 2. I can't see what would cause an issue for every other row. – Justin Jul 05 '21 at 20:32
@justin I can't see any problem with the code so it must be with the data. Is the template columm B completed correctly when the macro ends ie with the last row of data on ws1. – CDP1802 Jul 05 '21 at 21:25
When the macro ends, column B shows the correct data from the last row on ws1, as does column R. It's almost like the data is being copied to ws2 and the new XML file at the same time, even though the new XML hasn't been created yet. – Justin Jul 06 '21 at 00:30
@justin Try removing the lines that disable screen updating and events – CDP1802 Jul 06 '21 at 08:13

Trying to create a new XML document for each row in Excel worksheet

2 Answers2