尝试为 Excel 工作表中的每一行创建一个新的 XML 文档答案

【问题标题】：Trying to create a new XML document for each row in Excel worksheet尝试为 Excel 工作表中的每一行创建一个新的 XML 文档
【发布时间】：2021-07-06 22:53:13
【问题描述】：

我正在尝试为 Excel 文件中的每一行创建一个单独的 XML 文档。第 1 行列出标签名称，A 列标识每一行的文档标题。

我在 VBA 方面相当缺乏经验，但这是我迄今为止根据对类似问题的多个答案设法得出的结论。

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

我还没有完成“GetElementsByTagName”部分，因为该部分导致了问题。对于以下行，我收到错误“对象变量或未设置块变量”。

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

我知道它可能不是最优雅的，但根据我的阅读，它应该适用于超过 25 行的 XML（连续 'vbNewLine' 常量的限制）。

如果我在哪里出错，或者对更好的方法提出任何建议，我将不胜感激。

更新：我决定采用不同的方法，而且效果要好得多。但是，我仍然遇到一个问题。这是我所拥有的：

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

第一部分将特定单元格从 ws1 上的给定行复制到 ws2 上的特定单元格（其结构类似于所需的 XML 文件）。第二部分创建一个空白 XML 文件，其标题基于 A 列中当前行的值。最后一部分打开 XML 文件并从 ws2 打印所需的范围。然后它循环到 ws1 中的下一行。这适用于第一行，在 XML 中返回正确的格式和内容。

在随后的行中，单元格被正确复制到 ws2，新 XML 文件的标题取自 ws1 列 A 中的正确单元格。

从 ws2 打印到 XML 时会出现问题。它不是打印 ws2 中的指定范围，而是打印 ws1 中的行。（奇怪的是，它只在关闭 XML 并移动到下一行之前将行打印到 L 列。）

我尝试了多种编写 For Each 语句的方法，但所有公式都返回相同的结果或所有行的空白文件。谁能看到问题的原因？

谢谢！

最终更新：

终于弄明白了——是数据有问题。第 3 行中的一个单元格使用了弯引号而不是直引号。我猜这会导致宏读取不正确。

感谢大家的帮助！

【问题讨论】：

tl;dr 您对sTemplateXML 的字符串分配是一团糟，与您所说的关于 25 个代码行限制的内容不符。第一步：检查字符串结果（例如，通过 Debug.Print sTemplateXML 到 VB 编辑器的即时窗口）并编辑正确的分配（最好通过单独的函数调用），因为您向 prior 代码行添加了多个新分配下划线_ 而不是在出现sTemplateXML = sTemplateXML & <... /> ... 时开始单独的代码行。
在整理完模板后，下一个问题将是getElementsByTagName 由于命名空间而无法正常工作。详情请参阅here。
您在模板上填写“B”列，但打印“R”列，所以“R”中有公式吗？
对不起，是的。我在列 R 中连接列 A、B 和 C。我发现这使代码看起来更清晰。使用原始范围 (A1:C85) 也是可能的，但我可以让它工作的唯一方法是添加一个额外的 For 循环。

标签： excel xml vba

【解决方案1】：

您的 XML 文档一开始就损坏了，因此找不到所需的标签，因此出现了错误。运行代码后 sTemplateXML 变量的内容：

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

为了调试，使用Debug.Print sTemplateXML生成后打印sTemplateXML值或输出到文本文件：

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

sTemplateXML 生成过程中出错的原因之一是不正确的换行符，例如在第 9 行和第 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

最后一行被解释为比较 ...+ _ sTemplateXML = sTemplateXML &... 并在输出中生成第一个 False

【讨论】：

感谢您的反馈！很抱歉延迟回复，这是我在这里的第一个问题，我忘了检查它。经过一番思考，我认为这种方法存在太多问题，并决定继续使用另一种方法，它几乎完美地工作。我会将我的新代码添加到原始帖子中并解释问题（希望更容易解决）。

【解决方案2】：

无需先创建空白文件，使用TextStream object创建并写入文件。

'--------------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

【讨论】：

谢谢，稍后将对此进行测试并报告结果。
@Justin 您的代码使用 col B 对我来说工作正常，所以问题可能出在模板上
我刚刚尝试了上述解决方案并得到了相同的结果——第一个循环（lRow = 2）正常工作，但后续文件只包含从 ws1 到 L 列的行。模板是实际上只是将打开/关闭 XML 标记硬编码到 A 列和 C 列中。在 B 列中硬编码了一些固定值。我只是尝试将 For lRow = 2 to lLastRow 更改为 For lRow = 3 to lLastRow ，但它不起作用——它只会生成正确的 XML第 2 行。我看不出是什么会导致每隔一行出现问题。
@justin 我看不出代码有任何问题，所以它必须与数据有关。宏结束时模板列 B 是否正确完成，即 ws1 上的最后一行数据。
宏结束时，B 列显示 ws1 上最后一行的正确数据，R 列也是如此。这几乎就像数据同时被复制到 ws2 和新的 XML 文件，即使尚未创建新的 XML。