读取和更改Excel中多个XML文件（2007）VBA(Read and change multip

我想读一个完整的XML文件的文件夹，并更改参考号为特定的格式，它是今天的日期（年月月日日），缩写，8位数字的参考起始于00000001

例如120815AB00000001然后120815AB00000002等每个文件都有一个参考号码。 它被封闭在<CPAReferenceNumber>标记。

我使用Excel和VBA来读取文件和更改相关领域。 （下面它改变“这”成在代码'这现在）的基准被设置为默认值

此代码的工作在一个单独的文件，并作出正确的改变。 这些文件具有随机的名字，也没有命名约定的地方。 我无法扩大这一点在文件夹中的所有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

Answer 1:

使用Dir命令来搜索文件。

下面的例子将通过所有XML的文件中循环C:\Temp和返回的文件名（不带路径）：

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

sFileName = Dir(sSearchString)
Do While sFileName <> ""
    Debug.Print "Do something with file named " & sFileName
    sFileName = Dir()
Loop

现在，如果我结合你的原代码和我的Dir圈，我得到的东西，在我的环境中工作，希望这会为你工作。 我想你忘记了是sFileName只包含文件名，而不是完整的路径-让你写到不同的文件比你读什么，也许混淆了Do While sFileName <> ""循环的同时：

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

Answer 2:

使用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

文章来源: Read and change multiple XML files in Excel (2007) VBA