如何生成子文件夹的子文件夹？

Question

我有一个包含1000个文件的目录。文件名字符串类似于：ManagerName_EmployeeName_First Assessment.xlsx

但是我需要执行一种特定类型的分组，以便我的文件夹依次为ManagerName > Employee Name，然后是employees文件夹中的5种评估类型。

我如何编辑它以识别文件名中的第一个_ (ManagerName)，然后根据该ManagerName创建一个文件夹，然后通过EmployeeName创建子文件夹，然后将该employee下的所有五个文件放在employee子文件夹中？

我知道您需要使用Left(fileName, InStrRev(fileName, "_") > 1)类型函数来标识第一个_左侧的第一个文本字符串，但是我如何根据该经理下的员工创建第二个子文件夹呢？

下面是我所想的代码的外壳：

Option Explicit
Sub MoveFiles()

Dim objFSO          As Object
Dim objMyFolder     As Object
Dim objMyFile       As Object
Dim strSourceFolder As String
Dim strDestFolder   As String

Application.ScreenUpdating = False

strSourceFolder = "C:\Users\CIB\"

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objMyFolder = objFSO.GetFolder(strSourceFolder)

For Each objMyFile In objMyFolder.Files

    Do While objMyFile <> ""

        strDestFolder = Left(objMyFile.Name, InStrRev(objMyFile, "_") - 1)
        If Len(Dir(strDestFolder, vbDirectory)) = 0 Then
            MkDir strDestFolder
        End If

        FileCopy strSourceFolder & "\" & objMyFile.Name, strDestFolder & "\" & objMyFile.Name

        Kill strSourceFolder & "\" & objMyFile.Name

    Loop

Next objMyFile

Set objFSO = Nothing
Set objMyFolder = Nothing

Application.ScreenUpdating = True

End Sub

Answer 1

我已经根据TimWiliams的建议修改了你的代码：

Option Explicit

Sub MoveFiles()

    Dim objFSO          As Object
    Dim objMyFolder     As Object
    Dim objMyFile       As Object
    Dim strSourceFolder As String
    Dim strDestFolder   As String
    Dim parts() As String
    Dim i As Integer

    Application.ScreenUpdating = False

    strSourceFolder = "C:\Users\CIB\"

    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objMyFolder = objFSO.GetFolder(strSourceFolder)

    For Each objMyFile In objMyFolder.Files

        If objMyFile Is Nothing Then GoTo SkipNext

        parts = Split(objMyFile.Name, "_")
        strDestFolder = strSourceFolder
        For i = LBound(parts) To UBound(parts) - 1
            strDestFolder = strDestFolder & parts(i) & "\"
            'if path does not exists, create it
            If Not objFSO.FolderExists(strDestFolder) Then objFSO.CreateFolder strDestFolder

        FileCopy strSourceFolder & "\" & objMyFile.Name, strDestFolder & "\" & objMyFile.Name
        Kill strSourceFolder & "\" & objMyFile.Name
        strDestFolder = ""

        SkipNext:
    Next objMyFile

    Set objFSO = Nothing
    Set objMyFolder = Nothing

    Application.ScreenUpdating = True

End Sub