批量修改文件夹内，多个Word文件名中的同一个字或符号

13907933959

如：把 ※ 修改为 ～
相当于把几千个Word文件重命名。

请前辈们帮忙！谢谢！

jiminyanyan

没有附件。。。。。。。

13907933959

jiminyanyan 发表于 2016-8-30 13:29
没有附件。。。。。。。

前辈好！
上午忘了，现以上传至一楼，有劳前辈帮忙！谢谢！

413191246se

139：双击进入所要处理的文件夹：

1. Sub RenameFiles()
   
2. '文件改名：把 ※ 修改为 ～
   
3.     On Error Resume Next
   
4.     Dim fd As FileDialog, i As Long, doc As Document, p As String, docName As String, oldName As String
   
5.     Set fd = Application.FileDialog(msoFileDialogFolderPicker)
   
6.     If fd.Show = -1 Then p = fd.SelectedItems(1) Else Exit Sub
   
7.     Set fd = Nothing
   
8.     If MsgBox("是否处理文件夹 " & p & " ?", vbYesNo + vbExclamation, "循环遍历文件夹_修改文件名") = vbNo Then Exit Sub
   
9.     With Application.FileSearch
   
10.         .NewSearch
    
11.         .LookIn = p
    
12.         .SearchSubFolders = True
    
13.         .FileName = "*.doc"
    
14.         If .Execute > 0 Then
    
15.             For i = 1 To .FoundFiles.Count
    
16.                 oldName = .FoundFiles(i)
    
17.                 docName = Replace(oldName, "※", "～")
    
18.                 Name oldName As docName
    
19.             Next i
    
20.             MsgBox "处理完毕！共处理 " & .FoundFiles.Count & " 个文件！", vbOKOnly + vbExclamation, "循环遍历文件夹_修改文件名"
    
21.         Else
    
22.             MsgBox "未发现文件！", vbOKOnly + vbCritical, "循环遍历文件夹_修改文件名"
    
23.         End If
    
24.     End With
    
25. End Sub

复制代码

13907933959

413191246se 发表于 2016-8-30 18:45
139：双击进入所要处理的文件夹：

师傅好！
可准确替换，谢谢师傅！
师傅、能不能让它同时拥有替换文件名中的中英文字符的功能？

jiminyanyan

13907933959 发表于 2016-8-30 20:17
师傅好！
可准确替换，谢谢师傅！
师傅、能不能让它同时拥有替换文件名中的中英文字符的功能？

FileSearch 2007之后的就不能用了。

jiminyanyan

13907933959 发表于 2016-8-30 20:17
师傅好！
可准确替换，谢谢师傅！
师傅、能不能让它同时拥有替换文件名中的中英文字符的功能？

什么叫替换文件名中的中英文字符

13907933959

jiminyanyan 发表于 2016-8-30 20:55
什么叫替换文件名中的中英文字符

前辈好！
就是如文件名中既有中文字或中文符号，也有英文字母或英文符号的。
我师傅 413191246se  4楼的代码，可替换文件名中的中文字或中文符号，好象不能替换英文字母。

jiminyanyan

13907933959 发表于 2016-8-30 21:08
前辈好！
就是如文件名中既有中文字或中文符号，也有英文字母或英文符号的。
我师傅 413191246se  4楼 ...

能举个例子吗

jiminyanyan

1. Sub Macro1()
   
2.     On Error Resume Next
   
3.     Dim f, arr, brr, i&, j&
   
4.     f = Application.GetOpenFilename(fileFilter:="Word文件(*.doc*),*.doc*", Title:="选择Word文件", MultiSelect:=True)
   
5.     If TypeName(f) = "Boolean" Then Exit Sub
   
6.     Application.ScreenUpdating = False
   
7.     For i = LBound(f) To UBound(f)
   
8.         Name f(i) As Replace(f(i), "※", " ～")
   
9.     Next
   
10.     Application.ScreenUpdating = True
    
11.     MsgBox "ok"
    
12. End Sub

复制代码

代码放到EXCEL中。。。。。。