- 好友
- 1
- 在线时间
- 0 小时
- 最后登录
- 2023-10-6
随仆
- UID
- 3280159
- 第纳尔
- 306
- 精华
- 0
- 互助
- 2
- 荣誉
- 0
- 贡献
- 0
- 魅力
- 25
- 注册时间
- 2021-10-18
鲜花( 2) 鸡蛋( 0)
|
发表于 2021-10-30 15:11:47
|
显示全部楼层
本帖最后由 var7 于 2021-10-30 15:13 编辑
Dim arrFiles() As String
Dim countFiles%
Sub 替换文件内容()
Dim strPath$
Dim i%
Dim fso As New FileSystemObject, fd As Folder
'遍历文件夹
strPath = "C:\Users\Administrator\Desktop\操作台\替换区\"
ReDim arrFiles(0 To 999)
countFiles = 0
Set fd = fso.GetFolder(strPath)
SearchFiles fd
arrFiles = Filter(arrFiles, ".txt", True, vbTextCompare)
'替换每一个文件
For i = 0 To UBound(arrFiles)
Set txt = fso.OpenTextFile(arrFiles(i), 1, False)
stri = txt.ReadAll
txt.Close
Set txt = Nothing
'批量替换
For num = 1 To 65536
'If Cells(num, 1) <> "" And IsNumeric(Cells(num, 1)) Then
If Cells(num, 1) <> "" Then
stri = replace(stri, Cells(num, 1), Cells(num, 2))
Else
Exit For
End If
Next num
Set txt = fso.OpenTextFile(arrFiles(i), 2, True)
txt.Write (stri)
txt.Close
Set txt = Nothing
Set fs = Nothing
'MsgBox arrFiles(i) & "文件替换停止在规则的第" & num & "行"
Next i
MsgBox "文件替换停止在规则的第" & num & "行"
''输出改写数据
' MsgBox UBound(arrFiles) + 1
' For i = 0 To UBound(arrFiles)
' MsgBox arrFiles(i)
' Next i
End Sub
Sub SearchFiles(ByVal fd As Folder)
Dim fl As File
Dim sfd As Folder
For Each fl In fd.files
If countFiles > UBound(arrFiles) Then ReDim Preserve arrFiles(0 To countFiles + 999)
arrFiles(countFiles) = fl
countFiles = countFiles + 1
Next fl
End Sub |
|