在Excel（2007）VBA中读取和更改多个XML文件

我试图读取一个包含XML文件的文件夹，并将参考编号更改为一种特定格式，即今天的日期（yymmdd），首字母缩写，从00000001开始的8位参考

e、 g 120815AB00000001然后120815AB00000002等。每个文件有一个参考号。它包含在标记中

我正在使用Excel和VBA读取文件并更改相关字段。该引用设置为默认值（在下面的代码中，它暂时将“This”更改为“That”）

此代码在一个单独的文件上工作，并进行正确的更改。这些文件具有随机名称，并且没有适当的命名约定。我无法将其扩展到文件夹中的所有XML文件。任何帮助都将不胜感激

Sub ReplaceStringInFile()


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



sFileName = "c:\Search and Replace Files\blah.XML"
iFileNum = FreeFile

Open sFileName For Input As iFileNum
    Do Until EOF(iFileNum)

            Line Input #iFileNum, sBuf
            sTemp = sTemp & sBuf & vbCrLf

    Loop


Close iFileNum
sTemp = Replace(sTemp, "THIS", "THAT")

iFileNum = FreeFile

Open sFileName For Output As iFileNum
Print #iFileNum, sTemp

Close iFileNum

End Sub

在帮助后，我将其修改为以下代码，但这会导致错误： sFileName与上下文无关。文本更改不应用于xml文件

Sub ReplaceStringInFile()

Dim sBuf As String
Dim sTemp As String
Dim iFileNum As Integer
Dim sFileName As String
Const sSearchString As String = "c:\blah\*.xml"
Const directoryString As String = "c:\blah\"


iFileNum = FreeFile

sFileName = Dir(sSearchString)

Do While sFileName <> ""

      Open directoryString & sFileName For Input As iFileNum

        Do Until EOF(iFileNum)

                Line Input #iFileNum, sBuf
                sTemp = sTemp & sBuf & vbCrLf

        Loop


        Close iFileNum
        sTemp = Replace(sTemp, "IDNUMBER", "******SUCCESS!!!!!!******")

        iFileNum = FreeFile

        Open sFileName For Output As iFileNum
        Print #iFileNum, sTemp

        Close iFileNum

        Debug.Print "Do something with file named " & sFileName
        sFileName = Dir()

Loop


End Sub

子替换字符串填充（）
作为字符串的Dim sBuf
作为字符串的Dim sTemp
作为整数的Dim iFileNum
将sFileName设置为字符串
Const ssearch字符串为String=“c:\blah\*.xml”
Const directoryString As String=“c:\blah\”
iFileNum=FreeFile
sFileName=Dir（sSearchString）
当sFileName“”时执行此操作
打开directoryString&sFileName以作为iFileNum输入
直到EOF为止（iFileNum）
行输入#iFileNum，sBuf
sTemp=sTemp&sBuf&vbCrLf
环
近缘
sTemp=Replace（sTemp，“IDNUMBER”，“******成功！！！！！！！*******”）
iFileNum=FreeFile
打开sFileName以作为iFileNum输出
打印#iFileNum，sTemp
近缘
Debug.Print“使用名为的文件执行某些操作”&sFileName
sFileName=Dir（）
环
端接头

使用

Dir

命令搜索文件

以下示例将遍历

C:\Temp

中的所有XML文件，并返回文件名（不带路径）：

---

只是使用ADO Stream对象的一个细微变化：

Sub ReplaceStringInFile()
    'Don't forget to set a reference to Microsoft ActiveX Data Objects 2.8 Library
    Const sSearchString As String = "c:\temp\*.xml"
    Dim sTemp As String
    Dim sFileName As String
    Dim sFilePath As String
    sFileName = Dir(sSearchString)

    Dim objStream As Stream
    Set objStream = CreateObject("ADODB.Stream")
    objStream.Type = adTypeText
    objStream.Charset = "utf-8"

    Do While sFileName <> ""
        sFilePath = "c:\temp\" & sFileName  'Get full path to file

        objStream.Open
        objStream.LoadFromFile (sFilePath)
        sTemp = objStream.ReadText()
        sTemp = Replace(sTemp, "THIS", "THAT")
        objStream.Close

        objStream.Open
        objStream.WriteText sTemp, adWriteChar
        objStream.SaveToFile sFilePath, adSaveCreateOverWrite
        objStream.Close

        sFileName = Dir() 'Get the next file
    Loop
End Sub

子替换字符串填充（）
'不要忘记设置对Microsoft ActiveX Data Objects 2.8库的引用
Const ssearch字符串为String=“c:\temp\*.xml”
作为字符串的Dim sTemp
将sFileName设置为字符串
将sFilePath设置为字符串
sFileName=Dir（sSearchString）
模糊的对象流作为流
设置objStream=CreateObject（“ADODB.Stream”）
objStream.Type=adTypeText
objStream.Charset=“utf-8”
当sFileName“”时执行此操作
sFilePath=“c:\temp\”&sFileName“获取文件的完整路径”
对象流。打开
objStream.LoadFromFile（sFilePath）
sTemp=objStream.ReadText（）
sTemp=替换（sTemp，“这个”，“那个”）
objStream，关闭
对象流。打开
objStream.WriteText sTemp，adWriteChar
objStream.SaveToFile sFilePath，adSaveCreateOverWrite
objStream，关闭
sFileName=Dir（）'获取下一个文件
环
端接头

非常感谢您的帮助。您的循环正在工作，并在文件夹中的文件中循环。然而，一旦我将我的代码放在您的循环中，它就失去了sFileName的作用域，并且没有进行替换。我有：DoYourLoop MyLoop（来自上面的例子）Loop我已经用我现在尝试使用的完整代码编辑了原始问题。我真的很感谢你的帮助！好的，我想我明白了哪里不起作用了——我会很快在我的答案中添加我的原始代码版本。太棒了，非常感谢。我感谢你的帮助。它现在正在跨文件进行更改。我可以从这里开始。我太新了，不能投票支持这个答案，但它被标记为答案！你随时都可以稍后再来……；）

Sub ReplaceStringInFile()

    Const sSearchString As String = "c:\temp\*.xml"

    Dim sBuf As String
    Dim sTemp As String
    Dim iFileNum As Integer
    Dim sFileName As String
    Dim sFilePath As String


    sFileName = Dir(sSearchString)

    Do While sFileName <> ""

        sFilePath = "c:\temp\" & sFileName  'Get full path to file
        iFileNum = FreeFile
        sTemp = ""  'Clear sTemp

        Open sFilePath For Input As iFileNum

            Do Until EOF(iFileNum)

                Line Input #iFileNum, sBuf
                sTemp = sTemp & sBuf & vbCrLf

            Loop

        Close iFileNum

        sTemp = Replace(sTemp, "THIS", "THAT")

        iFileNum = FreeFile

        Open sFilePath For Output As iFileNum
        Print #iFileNum, sTemp

        Close iFileNum

        sFileName = Dir() 'Get the next file
    Loop
End Sub

Sub ReplaceStringInFile()
    'Don't forget to set a reference to Microsoft ActiveX Data Objects 2.8 Library
    Const sSearchString As String = "c:\temp\*.xml"
    Dim sTemp As String
    Dim sFileName As String
    Dim sFilePath As String
    sFileName = Dir(sSearchString)

    Dim objStream As Stream
    Set objStream = CreateObject("ADODB.Stream")
    objStream.Type = adTypeText
    objStream.Charset = "utf-8"

    Do While sFileName <> ""
        sFilePath = "c:\temp\" & sFileName  'Get full path to file

        objStream.Open
        objStream.LoadFromFile (sFilePath)
        sTemp = objStream.ReadText()
        sTemp = Replace(sTemp, "THIS", "THAT")
        objStream.Close

        objStream.Open
        objStream.WriteText sTemp, adWriteChar
        objStream.SaveToFile sFilePath, adSaveCreateOverWrite
        objStream.Close

        sFileName = Dir() 'Get the next file
    Loop
End Sub