如何通过Excel VBA宏修改并覆盖同路径下的XML文件

你代码里已经实例化了Scripting.FileSystemObject对象，直接调用它的文件写入方法覆盖原文件即可，在你标注的待补充代码位置插入以下代码：

' 覆盖写入原XML文件
Set ts = fso.CreateTextFile(filename, True) ' 第二个参数为True代表允许覆盖原有文件
ts.Write s
ts.Close

代码说明 #

• CreateTextFile方法第二个参数传True时，会直接覆盖目标路径的同名文件，不需要额外删除原文件
• 如果你的XML文件需要保留UTF-8编码避免乱码，可以改用ADODB.Stream对象写入，简体中文环境常规ANSI编码的场景下上述代码可以直接使用

修改后的完整代码 #

Option Explicit

Sub Button1_Click()
    Dim fso As Object, ts As Object, doc As Object
    Dim data As Object, filename As String
    Dim ws As Worksheet
    Set ws = ActiveSheet
    
    ' select file
    With Application.FileDialog(msoFileDialogFilePicker)
        If .Show <> -1 Then Exit Sub
        filename = .SelectedItems(1)
    End With
    
    ' read file and add top level
    Set doc = CreateObject("MSXML2.DOMDocument.6.0")
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.OpentextFile(filename)
    doc.LoadXML Replace(ts.readall, "<metadata>", "<root><metadata>", 1, 1) & "</root>"
    ts.Close
    
    ' import data tag only
    Dim s As String
    Set data = doc.getElementsByTagName("data")(0)
    s = data.XML
    ' MsgBox s
    
    ' replace the original XML file with contents of variable s here
    Set ts = fso.CreateTextFile(filename, True)
    ts.Write s
    ts.Close
    
    If MsgBox(s & vbCrLf & "已覆盖原文件", vbYesNo) = vbYes Then
        Application.SendKeys ("%lt")
    Else
        MsgBox "Ok"
    End If
End Sub

内容的提问来源于stack exchange，提问作者Sonal