CODEWITHSUNDEEP
excelxmlvba
Justin
Justin

Reputation: 3

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

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!

Upvotes: 0

Views: 545

Answers (2)

CDP1802
CDP1802

Reputation: 16174

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

Upvotes: 0

Алексей Р
Алексей Р

Reputation: 7627

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

Upvotes: 1

Related Questions