Translate

2013年6月9日 星期日

[VBA] Replace multiple strings in a file and files in a folder

https://github.com/walter426/VbaUtilities/blob/master/FileSysUtilities.bas

Below functions are written to do replacing in an efficient ways.

'Replace multiple strings in multiple files in a folder
Function ReplaceStrInFolder(folder_name As String, Arr_f As Variant, Arr_r As Variant, Optional StartRow As Long = 0) As String
    On Error GoTo Err_ReplaceStrInFolder
    
    Dim FailedReason As String
    
    Dim file_name As String
        
    file_name = Dir(folder_name & "\")
        
    Do Until file_name = ""
        file_name = folder_name & "\" & file_name
        Call ReplaceStrInFile(file_name, Arr_f, Arr_r, StartRow)
        file_name = Dir()
    Loop

Exit_ReplaceStrInFolder:
    ReplaceStrInFolder = FailedReason
    Exit Function
    
Err_ReplaceStrInFolder:
    FailedReason = Err.Description
    GoTo Exit_ReplaceStrInFolder
    
End Function

'Replace multiple strings in a file
Function ReplaceStrInFile(file_name As String, Arr_f As Variant, Arr_r As Variant, Optional StartRow As Long = 0) As String
    On Error GoTo Err_ReplaceStrInFile
    
    Dim FailedReason As String
    
    Dim temp_file_name As String
    temp_file_name = file_name & "_temp"
    
    On Error Resume Next
    Kill temp_file_name
    On Error GoTo Err_ReplaceStrInFile
    
    
    Dim iFileNum As String
    iFileNum = FreeFile()
    
    Open temp_file_name For Output As #iFileNum
    
    Dim fso As Object
    Dim File As Object
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set File = fso.OpenTextFile(file_name, 1)

    Dim row As Long
    Dim str_line As String
    Dim i As Integer
    Dim str_f As String
    Dim str_r As String

    row = 0


    Do Until File.AtEndOfStream = True 'EOF(2)
        row = row + 1
        
        str_line = File.ReadLine
    
        If row < StartRow Then
            GoTo Loop_ReplaceStrInFile_1
        End If
    
        For i = 0 To UBound(Arr_f)
            str_f = Arr_f(i)
            str_r = Arr_r(i)
            
            str_line = Replace(str_line, str_f, str_r)

        Next i
        
Loop_ReplaceStrInFile_1:

        Print #iFileNum, str_line
        
    Loop


    File.Close
    Close iFileNum
    Kill file_name
    Name temp_file_name As file_name
    

Exit_ReplaceStrInFile:
    ReplaceStrInFile = FailedReason
    Exit Function
    
Err_ReplaceStrInFile:
    FailedReason = Err.Description
    GoTo Exit_ReplaceStrInFile
    
End Function

沒有留言:

張貼留言