How can I make subfolders of subfolders? - vba

Question

I have a directory that has 1000's of files. The filename string goes like: ManagerName_EmployeeName_First Assessment.xlsx
but I have a specific type of grouping I need to execute so that I have folders go by ManagerName > Employee Name and then the 5 types of Assessments in the employees folder.
How would I edit this to identify the first _ in the filename (ManagerName) and then make a folder by that ManagerName and then make a subfolder by EmployeeName and then house all five files under that employee in the employee subfolder?
I know you'd need to use a Left(fileName, InStrRev(fileName, "_") > 1) type function to identify the first text string to the left of the first _ but how would I go and create a second subfolder based on the employee under that manager?
Here's a shell of the code I was thinking:
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

I've changed your code accordingly to TimWiliams suggestions:
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