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

Question

我是一名技术作家，不是一名程序员，我有数千个.xml文件，这些文件组合在一起可以创建一本书。我使用了这个网站上的VBA脚本来重命名所有文件，以符合新的指导原则，现在我需要进入xml代码，找到对这些链接的所有引用，并用新的文件名替换它们。

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

标签看起来像这样：

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

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

标签需要看起来像这样：

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

我尝试使用问题"如何在xml文件中查找/替换多个字符串？"中的代码？但它没有起作用，我甚至不确定这是否是问的正确问题

我当前的代码看起来是这样的：

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:Userss37739Desktopchap3"
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:Userss37739Desktopchap3"
Open sFileName For Output As iFileNum
Print #iFileNum, sTemp
Close iFileNum
End Sub
Sub mike1()
End Sub

Answer 1

您传递的是文件路径，而实际上您应该传递完全限定的文件名(文件路径和文件名)。你需要编辑那些行

' Edit as needed
sFileName = "C:Userss37739Desktopchap3"
'... 
' Alter sFileName first to save to a different file e.g.
sFileName = "C:Userss37739Desktopchap3"

带

' Edit as needed
sFileName = "C:Userss37739Desktopchap3yourfilename.xml"
'... 
' Alter sFileName first to save to a different file e.g.
sFileName = "C:Userss37739Desktopchap3yourNEWfilename.xml"

此外，在运行该过程时，请记住提供正确的范围。假设您的范围从"A1:B50"开始，您可以按如下方式编辑mike1子：

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

之后，您所需要做的就是从即时窗口运行mike1
对VBA编辑器使用Alt+F11进行访问，然后单击"查看"->"立即">
您应该在屏幕底部看到一个新窗口。只需在其中键入mike1，然后点击输入

---

更新：
理想情况下，您应该首先尝试理解当前的代码，并对其进行更改，使其在多个文件上工作，而不是每次运行一个文件。有很多地方可以为您提供如何做到这一点的示例，无论是递归地还是直接在函数中循环。有很多方法可以做到这一点，也有很多材料围绕着它

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

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

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

代码：

Public Sub ReplaceXML2()
Const HOST_PATH = "C:Userss37739Desktopchap3"    ' 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:Userss37739Desktopchap3"
Open fullFileName For Output As iFileNum
Print #iFileNum, sTemp
Close iFileNum
End If
Next
End Sub