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

Question

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

Olle Sjögren · Accepted Answer · 2012-08-15 14:28:50Z

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

Thank you very much for your help. Your loop is working and cycling through the files in the folder perfectly. However, once I place my code above within your loop it looses scope on sFileName and the replacement is not made. I have: Do YOURloop MyLoop (from example above) Loop
I have edited the original question with the full code I am now trying to use. I really appreciate your help!
OK, I think I see where it's not working - I'll add my version of your original code to my answer shortly.
Brilliant, thank you very much indeed. I appreciate the help. It is working across the files now to make the change. I can take it from here. I'm too new to vote the answer up, but it is marked as answer!

robertocm · Accepted Answer · 2017-06-17 18:28:54Z

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

Collectives™ on Stack Overflow

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

2 Answers 2

5 Comments

Comments

Linked

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

5 Comments

Comments

Linked

Related