如何制作子文件夹的子文件夹?

时间:2019-02-07 16:11:31

标签: vba

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

但是我需要执行一种特定类型的分组,以便使文件夹依次进入ManagerName> Employee Name,然后再进入employee文件夹中的5种评估类型。

我将如何编辑它以标识文件名(ManagerName)中的第一个_,然后通过该ManagerName创建一个文件夹,然后通过EmployeeName创建一个子文件夹,然后容纳所有雇员子文件夹中该雇员下的五个文件?

我知道您需要使用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

1 个答案:

答案 0 :(得分:0)

我已根据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