我有以下代码来检查预定义目录中是否存在文件夹。
images/screenshot_4.png
它可以正常工作,但仅检查“ D:\”的子文件夹,而不能超过该子文件夹。
我的文件夹可以出现在任何位置(在子文件夹或其子文件夹中或在“ D:\”的子文件夹旁边。
我关心的是如何遍历所有文件夹。
答案 0 :(得分:0)
我不久前做了这件事。基本上,我用它来重命名文件夹和子文件夹中的文件,
Option Explicit
Sub VersionRename()
Dim SelectedFolder As FileDialog
Dim T_Str As String
Dim FSO As Object
Dim RenamingFolder As Object, SubFolder As Object
Dim T_Name As String
Set SelectedFolder = Application.FileDialog(msoFileDialogFolderPicker)
SelectedFolder.Title = "Select folder:"
SelectedFolder.ButtonName = "Select Folder"
If SelectedFolder.Show = -1 Then
T_Str = SelectedFolder.SelectedItems(1)
Else
'MsgBox "Cancelled by user.", vbInformation
Set SelectedFolder = Nothing
Exit Sub
End If
Set SelectedFolder = Nothing
Set FSO = CreateObject("Scripting.FileSystemObject")
Set RenamingFolder = FSO.GetFolder(T_Str)
File_Renamer RenamingFolder
For Each SubFolder In RenamingFolder.SubFolders
File_Renamer SubFolder
Next
Set SubFolder = Nothing
Set RenamingFolder = Nothing
Set FSO = Nothing
MsgBox "Process completed!", vbInformation, Title:="Renaming Files"
End Sub
Private Sub File_Renamer(Folder As Object)
Dim File As Object
Dim T_Str As String
Dim T_Name As String
Dim PreVersionID As Variant
Dim NextVersionID As Variant
Dim StringReplace As String
PreVersionID = Application.InputBox("Input 1 if no version number otherwise input existing version number:", Type:=1)
If PreVersionID = False Then Exit Sub
NextVersionID = Application.InputBox("Input your next version number:", Type:=1)
If NextVersionID = False Then Exit Sub
T_Str = Format("_V" & NextVersionID)
For Each File In Folder.Files
T_Name = File.Name
'Debug.Print T_Name
If NextVersionID > 1 Then
StringReplace = Replace(T_Name, "_V" & PreVersionID, "", 1, 3)
'Debug.Print StringReplace
File.Name = Left(StringReplace, InStrRev(StringReplace, ".") - 1) & T_Str & Right(StringReplace, Len(StringReplace) - (InStrRev(StringReplace, ".") - 1))
Else
File.Name = Left(T_Name, InStrRev(T_Name, ".") - 1) & T_Str & Right(T_Name, Len(T_Name) - (InStrRev(T_Name, ".") - 1))
End If
Next
End Sub