'遍历文件
Sub LookUpAllFiles(fld As Folder)
Dim fs As New FileSystemObject
Dim fil As file, outFld As Folder '定义一个文件夹和文件变量
Set subfiles = fld.Files() '获取文件夹下所有文件
Set SubFolders = fld.SubFolders '获取文件夹下所有文件夹
For Each fil In fld.Files '遍历文件
'Debug.Print fil
If fs.GetExtensionName(fil) = "doc" Or fs.GetExtensionName(fil) = "docx" Then
If InStr(fil, "山东") Or InStr(fil, "山 东") Or InStr(fil, "山 东 ") Then
Name fil As Mid(fil, 1, InStrRev(fil, "\")) & "山东-" & Mid(fil, InStrRev(fil, "\") + 1, Len(fil) - InStrRev(fil, "\"))
ElseIf InStr(fil, "安徽") Or InStr(fil, "安 徽") Or InStr(fil, "安 徽 ") Then
Name fil As Mid(fil, 1, InStrRev(fil, "\")) & "安徽-" & Mid(fil, InStrRev(fil, "\") + 1, Len(fil) - InStrRev(fil, "\"))
ElseIf InStr(fil, "陕西") Or InStr(fil, "陕 西") Or InStr(fil, "陕 西 ") Then
Name fil As Mid(fil, 1, InStrRev(fil, "\")) & "陕西-" & Mid(fil, InStrRev(fil, "\") + 1, Len(fil) - InStrRev(fil, "\"))
Else
End If
End If
Next
For Each outFld In SubFolders '遍历文件夹
LookUpAllFiles outFld '调用函数自身
Next
End Sub
Sub tt()
Dim fso As New FileSystemObject
Dim fld As Folder, sr As String
On Error Resume Next
sr = "C:\Users\Administrator\Desktop\新建文件夹\"
If fso.FolderExists(sr) Then
Set fld = fso.GetFolder(sr)
LookUpAllFiles fld
Else
Debug.Print "文件不存在"
End If
Debug.Print "Finish!"
End Sub