Question

我是一名技术作家而不是编码员，我有成千上万的.xml文件组合起来创作一本书。我使用来自这个网站的VBA脚本重命名所有文件以适应新的指南，现在我需要进入xml代码并查找对这些链接的所有引用并用新文件名替换它们。

我有一个Excel电子表格，其中A列中有旧文件名，B列中有新文件名。

标签如下所示：

<?iads.link docref="R381"?>

需要在A列中找到"R381"，并将其替换为{B}列中相邻单元格中的文件名"R01081-1-1520-237"。

标签需要如下所示：

<?iads.link docref="R01081-1-1520-237"?>

我尝试使用问题How can I Find/Replace multiple strings in an xml file?中的代码，但它不起作用，我甚至不确定这是否是正确的问题

我目前的代码看起来像这样：

Option Explicit ' Use this !

Public Sub ReplaceXML(rFindReplaceRange As Range) ' Pass in the find-replace range

    Dim sBuf As String
    Dim sTemp As String
    Dim iFileNum As Integer
    Dim sFileName As String
    Dim i As Long

    ' Edit as needed
    sFileName = "C:\Users\s37739\Desktop\chap3"

    iFileNum = FreeFile
    Open sFileName For Input As iFileNum

    Do Until EOF(iFileNum)
        Line Input #iFileNum, sBuf
        sTemp = sTemp & sBuf & vbCrLf
    Loop

    Close iFileNum

    ' Loop over the replacements
    For i = 1 To rFindReplaceRange.Rows.Count
        If rFindReplaceRange.Cells(i, 1) <> "" Then
            sTemp = Replace(sTemp, rFindReplaceRange.Cells(i, 1), rFindReplaceRange(i, 2))
        End If
    Next i

    ' Save file

    iFileNum = FreeFile

    ' Alter sFileName first to save to a different file e.g.
    sFileName = "C:\Users\s37739\Desktop\chap3"
    Open sFileName For Output As iFileNum

    Print #iFileNum, sTemp

    Close iFileNum

End Sub
Sub mike1()

End Sub

Answer 1

您正在传递文件路径，实际上您应该传递完全限定的文件名（文件路径和文件名）。您需要编辑这些行

' Edit as needed
sFileName = "C:\Users\s37739\Desktop\chap3"

'... 

' Alter sFileName first to save to a different file e.g.
sFileName = "C:\Users\s37739\Desktop\chap3"

用

' Edit as needed
sFileName = "C:\Users\s37739\Desktop\chap3\yourfilename.xml"

'... 

' Alter sFileName first to save to a different file e.g.
sFileName = "C:\Users\s37739\Desktop\chap3\yourNEWfilename.xml"

另外，请记住在运行该过程时提供正确的范围。假设您的范围来自＆＃34; A1：B50＆＃34;您可以按如下方式修改mike1子资料：

Sub mike1()
    ' Change range as desired
    Call ReplaceXML(ThisWorkbook.Worksheets("YourSheetName").Range("A1:B50")) 
End Sub

之后，您需要做的就是从立即窗口运行mike1 使用Alt + F11访问VBA编辑器然后查看 - ＆gt;立即。
您应该在屏幕底部看到一个新窗口。只需在其中输入mike1，然后按 Enter

<强>更新
理想情况下，您应首先尝试了解您当前拥有的代码并更改它，使其适用于多个文件，而不是每次运行一个文件。周围有很多地方可以给你提供如何做到这一点的例子，无论是递归还是循环直接进入函数。有很多方法可以做到这一点以及围绕它的许多材料。

话虽如此，您可以在下面找到解决问题的众多方法之一。以下代码由两个Sub组成，您可以将其复制/粘贴到模块中。

您需要使用主文件夹更改HOST_PATH的值，并使用要处理的范围更改findReplaceRange。您需要使用工作表的名称更改"Sheet1"，并使用实际范围更改"A1:B10"。之后，只需运行ReplaceXML2() Sub。

注意：这会更新所提供文件夹下的所有 XML文件，因此请确保在运行之前为其提供了足够的测试（最好是备份文件）整个文件夹。如果您还有其他问题我建议再问一个问题。

<强>代码：

Public Sub ReplaceXML2()

    Const HOST_PATH = "C:\Users\s37739\Desktop\chap3\"    ' change accordingly
    Dim findReplaceRange As Range
    Set findReplaceRange = ThisWorkbook.Worksheets("Sheet1").Range("A1:B10") ' change accordingly

    Dim FileSystem As Object
    Set FileSystem = CreateObject("Scripting.FileSystemObject")
    Call RecursivelyReplaceXML(FileSystem.GetFolder(HOST_PATH), findReplaceRange)

End Sub

Public Sub RecursivelyReplaceXML(parentFolder, rFindReplaceRange As Range) ' Pass in the folder and the find-replace range

    Dim subFolder As Object
    For Each subFolder In parentFolder.SubFolders
        RecursivelyReplaceXML subFolder, rFindReplaceRange
    Next

    Dim file As Object
    For Each file In parentFolder.Files

        If Right(file.Name, 4) = ".xml" Then

            Dim iFileNum As Integer
            Dim sTemp As String
            Dim sBuf As String
            Dim i As Long
            Dim fullFileName As String

            fullFileName = file.Path
            iFileNum = FreeFile
            Open fullFileName For Input As iFileNum

            sTemp = ""  ' clean up to read the next file
            Do Until EOF(iFileNum)
                Line Input #iFileNum, sBuf
                sTemp = sTemp & sBuf & vbCrLf
            Loop

            Close iFileNum

            ' Loop over the replacements
            For i = 1 To rFindReplaceRange.Rows.count
                If rFindReplaceRange.Cells(i, 1) <> "" Then
                    sTemp = Replace(sTemp, rFindReplaceRange.Cells(i, 1), rFindReplaceRange(i, 2))
                End If
            Next i

            ' Save file
            iFileNum = FreeFile

            ' WARNING: New name definition commented out,
            ' which means all files will be replaced with newer versions!!
            '===
            ' Alter fullFileName first to save to a different file e.g.
            ' fullFileName = "C:\Users\s37739\Desktop\chap3\"
            Open fullFileName For Output As iFileNum

            Print #iFileNum, sTemp

            Close iFileNum

        End If
    Next

End Sub

如何根据电子表格值更改XML中的多个引用标记

1 个答案: