Question

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

例如120815AB00000001然后120815AB00000002等。每个文件都有一个参考编号。它包含在＆lt; CPAReferenceNumber＆GT;标签

我使用Excel和VBA读取文件并更改相关字段。该引用被设置为默认值（在下面的代码中，它会更改＆＃39;这个＆＃39;现在为＆＃39;

;

此代码适用于一个单独的文件并进行正确的更改。这些文件具有随机名称，并且没有适当的命名约定。我无法将其扩展到文件夹中的所有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命令搜索文件。

以下示例将遍历C:\Temp中的所有XML文件并返回文件名（不带路径）：

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 <> ""循环：< / p>

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

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

2 个答案: