Read and change multiple XML files in Excel (2007) VBA

问题

I'm trying to read a folder full of XML files and change the reference number into a specific format which is Today's DATE(yymmdd), Initials, 8 digit reference starting at 00000001

e.g 120815AB00000001 then 120815AB00000002 etc. Each file has ONE reference number. It is enclosed in the < CPAReferenceNumber> tag.

I'm using Excel and VBA to read the files and change the relevant field. The reference is set to a default value (in the code below it changes 'This' into 'That' for now)

This code works on one individual file and makes the correct change. The files have random names and there is no naming convention in place. I'm unable to expand this out to all XML files in the folder. Any help would be greatly appreciated.

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

After Help I have modified it to the below code, this is however causing errors: sFileName is out of context. The text change is not applied to the xml files.

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

回答1:

Use the Dir command to search for files.

The following example will loop through all XML-files in C:\Temp and return the file names (without the path):

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

Now, if I combine your original code and my Dir loop, I get something that works in my environment, hopefully it will work for you. What I think you forgot was that sFileName only contains the filename and not the full path - so you wrote to a different file than what you read from and maybe confused the Do While sFileName <> "" loop at the same time:

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

回答2:

Just a slight variation using ADO Stream Object:

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

来源：https://stackoverflow.com/questions/11968572/read-and-change-multiple-xml-files-in-excel-2007-vba