当前位置: 首页 > 知识库问答 >
问题:

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

颜云瀚
2023-03-14

我正在尝试为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”部分,因为该部分导致了问题。对于下一行,我得到错误“Object variable or With block variable not set”。

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中的行。(奇怪的是,它只打印行到L列,然后关闭XML并移动到下一行。)

我尝试了多种编写For-Each语句的方法,但所有公式都会为所有行返回相同的结果或空白文件。有人知道问题的原因吗?

谢啦!

最终更新:

终于解决了——这是数据的问题。第3行中的一个单元格使用了花引号而不是直引号。我猜这导致宏错误地读取它。

谢谢大家的帮助!

共有2个答案

宣原
2023-03-14

不需要先创建空白文件,使用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
越嘉石
2023-03-14

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生成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

 类似资料:
  • 我正在处理一个Excel工作簿,我希望工作簿为每一行新数据创建一个新工作表。下面的代码确实可以做到这一点,但问题是Excel使用每一行第一列中的文本作为新工作表的名称。我想更改它并使另一列成为新工作表名称的来源。请告知我需要更改哪一行才能完成此操作。谢谢您的帮助!

  • 数据 第一页用于数据输入。每行代表一张服务票。每列将表示有关服务事件的数据,如序列号或型号。 期望的结果 对于包含特定字段(列a ~“票证号”)中数据的每一行,Excel将基于模板创建一个新的工作表(服务票证),并将相应行中的数据放入指定的单元格中。 提前感谢您提供的任何帮助。

  • 如图所示,我有原始数据(A2:C6),我想根据B列中的每个唯一值创建一个新工作簿。在该示例中,“颜色”列中有4种颜色和3种唯一颜色,因此我将创建3个不同的新工作簿(Red.xlsx、Yellow.xlsx和Orange.xlsx),如图底部所示。 所以我想到的代码如下,但不确定如何检查工作簿是否已经创建: 我的代码的问题是,它会创建重复的工作簿,如红色。在本例中,xlsx两次。对于如何解决问题或采

  • 我有如下数据集: 这是我们数据库中每个帐户的备忘录集合。“1abc”中的1表示帐户ID,字母表示一些文本。总共有177列和1866行,但并非每行都有177列之前的值,有些行可能只有两列数据。 我需要每一列下拉到A列的底部,以便所有数据只占用A列。例如,B列中的所有数据都将插入A列中的最后一个值之后。C列中的数据将插入A列中的最后一个值之后,它已填充了来自B的数据,依此类推。 最后,它应该是这样的(

  • 我正在尝试使用一个包含多行数据的Excel工作表,并使用行中的一个值作为新工作簿名称为每一行创建单独的工作簿。这些工作簿将保存为逗号分隔的工作簿,以便它们可以上传到机器的控制器中。我可以手动打开一个新工作簿并从基本工作簿中获取单元格的外部引用,但对如何编写循环以使其自动在行中移动并创建新工作簿以及如何使用其中一个值作为新工作簿的名称感到困惑。 基本工作簿的结构是从A到J的行,其中A列包含我要将新工

  • 我有以下代码,可以很好地将相关数据复制到我的工作表中。我为J列中的每个唯一部门手动创建每个工作表,然后运行此宏。我想要一个基于J列中的唯一值动态创建工作表的宏。我在网上找到了很好的资源,但当它到达已经为其创建了工作表的行时,我发现的资源似乎会出错。在手动创建其他工作表之前,我包含了我当前使用的代码以及我的清单表的屏幕截图