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

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

这里有一个前后比较：

之前（导入Excel之前的XML文件）

...
...

之后（从Excel导出后的XML文件）

...
...

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

---

第二个问题：有没有更好的工具可以使用类似Excel的UI轻松编辑XML文件的某些部分？

好的，我咬紧牙关，编写了一个很好的ol'VBA宏。我想我会和大家分享，以防其他人遇到同样的问题

该宏基本上调用Excel的内置XML Export（）方法，然后对生成的文件执行一系列文本替换。文本替换完全由您决定。只需将它们放在工作表中，就像下面链接中的工作表一样

如何设置“替换规则”的示例：

在本例中，我将tab替换为空格，“：ns1”替换为空白，“ns1:”替换为空白，将剥离的根元素替换为原始根元素

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

选择所有“查找内容”单元格，并将其命名为*“FindWhat”（选择中不要包含标题行；空格将被忽略）

选择所有“替换为”单元格，并将其命名为*“替换为”（在“查找内容”和“替换为”单元格之间应存在一对一的映射；使用空格删除不需要的文本）

在工作簿中的某个位置输入XML映射的名称，并将该单元格命名为“XmlMap”

运行宏。（系统将要求您指定要导出到的文件。）

*如果不熟悉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

选项显式
子ExportXml（）
将exportResult设置为XlXmlExportResult
将导出路径设置为字符串
Dim xmlMap作为字符串
将文件内容设置为字符串
exportPath=RequestExportPath（）
如果exportPath=“或exportPath=”False”，则退出Sub
xmlMap=范围（“xmlMap”）
exportResult=ActiveWorkbook.XmlMaps（xmlMap）.Export（exportPath，True）
如果exportResult=xlXmlExportValidationFailed，则
嘟嘟声
出口接头
如果结束
fileContents=ReadInTextFile（exportPath）
fileContents=ApplyReplaceRules（fileContents）
WriteTextToFile导出路径，文件内容
端接头
函数ApplyReplaceRules（文件内容为字符串）为字符串
将工作表替换为工作表
变暗FindHatRange作为范围
Dim replaceWithRange As range
暗淡的鱼鳍什么样的线
将替换为字符串
将单元格设置为整数
设置findWhatRange=range（“FindWhat”）
设置replaceWithRange=range（“ReplaceWith”）
对于cell=1，查找dwhatrange.Cells.Count
findWhat=findWhatRange.Cells（单元格）
如果找到了什么“”，那么
replaceWith=replaceWithRange.Cells（单元格）
fileContents=Replace（fileContents、findWhat、replaceWith）
如果结束
下一个细胞
ApplyReplaceRules=文件内容
端函数
函数RequestExportPath（）作为字符串
将messageBoxResult设置为VbMsgBoxResult
将导出路径设置为字符串
将消息设置为字符串
message=“该文件已存在。是否要替换它？”
做正确的事
exportPath=Application.GetSaveAsFilename（“，”XML文件（*.XML），*.XML”）
如果exportPath=“False”，则退出Do
如果文件不存在（导出路径），则退出Do
messageBoxResult=MsgBox（消息，vbYesNo，“文件存在”）
如果messageBoxResult=vbYes，则退出Do
环
RequestExportPath=exportPath
端函数
函数FileExists（路径为字符串）为布尔值
Dim文件系统对象
设置fileSystemObject=CreateObject（“Scripting.fileSystemObject”）
FileExists=fileSystemObject.FileExists（路径）
端函数
函数ReadInTextFile（路径为字符串）为字符串
Dim文件系统对象
暗淡的文本流
将文件内容设置为字符串
将线变暗为字符串
设置fileSystemObject=CreateObject（“Scripting.fileSystemObject”）
Set textStream=fileSystemObject.OpenTextFile（路径）
fileContents=textStream.ReadAll
文本流，关闭
ReadInTextFile=fileContents
端函数
子WriteTextToFile（路径为字符串，文件内容为字符串）
Dim文件系统对象
暗淡的文本流
设置fileSystemObject=CreateObject（“Scripting.fileSystemObject”）
Set textStream=fileSystemObject.CreateTextFile（路径，True）
textStream.Write文件内容
文本流，关闭
端接头

实际上，这要容易得多

将

.xlsx

后缀更改为

.zip

-

xlsx

格式实际上是压缩的

xml

文件

在Windows资源管理器中打开zip文件

浏览到

xl

子目录

将

xmlMaps.xml

文件复制到

.zip之外的位置
<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<ns1:database xmlns:ns1="experimentManager">
    <ns1:conditionTokens>
        ...
    </ns1:conditionTokens>
    <ns1:participants>
        ...
    </ns1:participants>
</ns1:database>

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

Workbooks.OpenText Filename:= _
    Store & "\" & "\" & sFilename & ".txt", _
    Origin:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
    xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
    Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), _
    TrailingMinusNumbers:=True
Cells.Replace What:="ns1:", Replacement:="", LookAt:=xlPart, SearchOrder _
    :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
ActiveWorkbook.SaveAs Filename:= _
    Store & "\" & "\" & sFilename & ".prn", _
    FileFormat:=xlTextPrinter, CreateBackup:=False
ActiveWorkbook.Close savechanges:=False