好吧，我硬着头皮写了一个不错的 VBA 宏。我想我会与大家分享，以防其他人遇到同样的问题。
此宏基本上调用 Excel 的内置 XML Export() 方法，然后对生成的文件执行一系列文本替换。文本替换完全取决于您。只需将它们放在如下链接中的工作表中...
如何设置“替换规则”的示例：
Click me for screen cap
在此示例中，我将 tab 替换为空格，将 ":ns1" 替换为空白，将 "ns1:" 替换为空白，并将精简后的根元素替换为原始根元素。
您可以按照自己喜欢的方式设置替换规则的格式，只要您遵循以下说明：
- 选择所有“查找内容”单元格并将其命名为*“FindWhat”（不要在您的选择中包含标题行；空白将被忽略）。
- 选择所有“替换为”单元格并为其命名*“ReplaceWith”（“查找内容”和“替换为”单元格之间应该存在一对一的映射关系；使用空格删除不需要的文本)。
- 在工作簿的某处输入 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