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

Question

我正试图为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:UsersDuckDocumentsBatch IngestXML" & 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"；部分，因为该部分导致了问题。对于下面的行，我得到错误"；对象变量或With块变量未设置"；。

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行中的一个单元格使用了花引号而不是直引号。我想这会导致宏读取错误。

谢谢大家的帮助！

Answer 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

Answer 2

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

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