xml - 有没有办法让 Excel 在根元素中保留 XML 属性？

Question

我一直在尝试使用 MS Excel 2007 编辑存储在 XML 文件中的表格数据。它可以很好地导入甚至根据模式(xsd 文件)验证 XML 数据，但是当我导出时，它会从根元素中删除 xmlns、xlmns:xsi 和 xsi:schemaLocation 属性。它还将默认命名空间更改为显式命名空间。

这是前后对比:

之前(导入Excel之前的XML文件)

<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<database
  xmlns="experimentManager"
  xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
  xsi:schemaLocation="experimentManager Database.xsd">
  <conditionTokens>
    ...
  </conditionTokens>
  <participants>
    ...
  </participants>
</database>

After(Excel导出后的XML文件)

<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<ns1:database xmlns:ns1="experimentManager">
    <ns1:conditionTokens>
        ...
    </ns1:conditionTokens>
    <ns1:participants>
        ...
    </ns1:participants>
</ns1:database>

有什么方法可以防止 Excel 剥离这些属性并弄乱命名空间吗？我已经阅读了关于 XML 映射和导入/导出的 MS 帮助，但在 GUI 中似乎没有任何设置可以满足我的要求。如果我需要编写自定义宏，那是有可能的，但如果有更好/更简单的方法，我宁愿不这样做。

第二个问题:是否有更好的工具可以使用类似 Excel 的用户界面轻松编辑 XML 文件的某些部分？

Answer 1

好吧，我硬着头皮写了一个不错的 VBA 宏。我想我会与大家分享它，以防其他人遇到同样的问题。

这个宏主要是调用 Excel 的内置 XML Export() 方法，然后对生成的文件执行一系列文本替换。文本替换完全取决于您。只需将它们放在如下链接中的工作表中...

如何设置“替换规则”的示例: Click me for screen cap

在此示例中，我将制表符替换为空格，将“:ns1”替换为空白，将“ns1:”替换为空格，并将精简的根元素替换为原始根元素。

只要遵循以下说明，您就可以按照自己喜欢的方式格式化替换规则:

1. 选择所有“查找内容”单元格并为它们命名*“FindWhat”(不要在您的选择中包含标题行；空白将被忽略)。
2. 选择所有“替换为”单元格并给它们命名*“ReplaceWith”(“查找内容”和“替换为”单元格之间应该存在一对一的映射；使用空格删除不需要的文本).
3. 在工作簿中的某处输入 XML 映射的名称，并将该单元格命名为“XmlMap”。
4. 运行宏。 (系统会要求您指定要导出到的文件。)

*如果您不熟悉 Excel 2007 中的命名范围，请单击“公式”选项卡并选择“名称管理器”。

好吧，我不会再让你悬念了(笑)...这是宏的代码。只需将它放在 VBA 编辑器的模块中。我对这个免费代码不提供任何保证(如果你没有正确命名范围，你很容易破坏它)，但我试过的几个例子对我有用。

Option Explicit

Sub ExportXml()
    Dim exportResult As XlXmlExportResult
    Dim exportPath As String
    Dim xmlMap As String
    Dim fileContents As String
    exportPath = RequestExportPath()
    If exportPath = "" Or exportPath = "False" Then Exit Sub
    xmlMap = range("XmlMap")
    exportResult = ActiveWorkbook.XmlMaps(xmlMap).Export(exportPath, True)
    If exportResult = xlXmlExportValidationFailed Then
        Beep
        Exit Sub
    End If
    fileContents = ReadInTextFile(exportPath)
    fileContents = ApplyReplaceRules(fileContents)
    WriteTextToFile exportPath, fileContents
End Sub

Function ApplyReplaceRules(fileContents As String) As String
    Dim replaceWorksheet As Worksheet
    Dim findWhatRange As range
    Dim replaceWithRange As range
    Dim findWhat As String
    Dim replaceWith As String
    Dim cell As Integer
    Set findWhatRange = range("FindWhat")
    Set replaceWithRange = range("ReplaceWith")
    For cell = 1 To findWhatRange.Cells.Count
        findWhat = findWhatRange.Cells(cell)
        If findWhat <> "" Then
            replaceWith = replaceWithRange.Cells(cell)
            fileContents = Replace(fileContents, findWhat, replaceWith)
        End If
    Next cell
    ApplyReplaceRules = fileContents
End Function

Function RequestExportPath() As String
    Dim messageBoxResult As VbMsgBoxResult
    Dim exportPath As String
    Dim message As String
    message = "The file already exists. Do you want to replace it?"
    Do While True
        exportPath = Application.GetSaveAsFilename("", "XML Files (*.xml),*.xml")
        If exportPath = "False" Then Exit Do
        If Not FileExists(exportPath) Then Exit Do
        messageBoxResult = MsgBox(message, vbYesNo, "File Exists")
        If messageBoxResult = vbYes Then Exit Do
    Loop
    RequestExportPath = exportPath
End Function

Function FileExists(path As String) As Boolean
    Dim fileSystemObject
    Set fileSystemObject = CreateObject("Scripting.FileSystemObject")
    FileExists = fileSystemObject.FileExists(path)
End Function

Function ReadInTextFile(path As String) As String
    Dim fileSystemObject
    Dim textStream
    Dim fileContents As String
    Dim line As String
    Set fileSystemObject = CreateObject("Scripting.FileSystemObject")
    Set textStream = fileSystemObject.OpenTextFile(path)
    fileContents = textStream.ReadAll
    textStream.Close
    ReadInTextFile = fileContents
End Function

Sub WriteTextToFile(path As String, fileContents As String)
    Dim fileSystemObject
    Dim textStream
    Set fileSystemObject = CreateObject("Scripting.FileSystemObject")
    Set textStream = fileSystemObject.CreateTextFile(path, True)
    textStream.Write fileContents
    textStream.Close
End Sub