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
沒有留言:
張貼留言