首页
学习
活动
专区
圈层
工具
发布
社区首页 >问答首页 >如何使用vba遍历所有子文件夹及其子子文件夹等,检查文件夹是否存在?

如何使用vba遍历所有子文件夹及其子子文件夹等,检查文件夹是否存在?
EN

Stack Overflow用户
提问于 2019-05-30 21:01:05
回答 1查看 99关注 0票数 1

我有下面的代码来检查文件夹是否存在于预定义的目录中。

代码语言:javascript
复制
Option Explicit
Public xStatus As String


Sub Status()
Application.ScreenUpdating = False
Dim fso As Object
Dim folder As Object
Dim subfolders As Object
Dim subfolder1 As Object
Dim Rg As Range
Dim xCell As Range
Dim xTxt As String



xTxt = ActiveWindow.RangeSelection.Address
Set Rg = Application.InputBox("Please select city/cities to check production status!!!      ", "Lmtools", xTxt, , , , , 8)
If Rg Is Nothing Then
    MsgBox ("No cities selected!!!")
    Exit Sub
End If
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder("D:\")
Set subfolders = folder.subfolders
For Each xCell In Rg
    If xCell.Value <> "" Then
        For Each subfolder1 In subfolders
            xStatus = subfolder1.path
            If xStatus Like "*?\" & xCell.Value Then
                Cells(xCell.Row, xCell.Column + 1).Value = "Completed"
                Cells(xCell.Row, xCell.Column + 2).Value = xStatus
                GoTo nextiteration
            Else
                Cells(xCell.Row, xCell.Column + 1).Value = "Ongoing"
            End If
        Next
    End If
nextiteration:
Next

Application.ScreenUpdating = True
End Sub

它工作得很好,但只检查"D:\“的子文件夹,而不检查更多的子文件夹。

我的文件夹可以出现在任何地方(在子文件夹或其子文件夹中,或者在“D:\”的子文件夹旁边)。

我关心的是如何遍历所有的文件夹。

EN

Stack Overflow用户

回答已采纳

发布于 2019-05-31 04:24:22

这是我前段时间写的。基本上,我用它来重命名文件夹和子文件夹中的文件,

代码语言:javascript
复制
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
票数 0
EN
查看全部 1 条回答
页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接:

https://stackoverflow.com/questions/56378852

复制
相关文章

相似问题

领券
问题归档专栏文章快讯文章归档关键词归档开发者手册归档开发者手册 Section 归档