Help with Batch file to move files into specific folders

[BalloutMoe]

Hello all,
Looking for some help on moving files to a specific folders if that folder exists if not create it.
For example
I have file names and they can vary by how many words they are.
Mike James 07-13-21.pdf
Christopher R.Ricci 07-13-21.pdf
Christopher R.Ricci 07-13-21_part002.pdf
Bradley T. Jackson 07-13-21.pdf


I would like to move these files into subfolders named, notice Christopher has two files and would like them to be in the same folder.
Mike James
Christopher R.Ricci
Bradley T. Jackson

Any help with this please?

@Echo off
PushD C:\Users\axela\Desktop\Payroll\2001
for %%A in ("* *.*") do for /f "tokens=1*" %%B in ("%%A") do (
If not exist "%%B" MD "%%B"
Move "%%A" "%%B\%%C"
)
PopD


I have the following code but it only takes the first name for the folder and the rest in the file name inside.
Folder names are : Christopher or Mike or Bradley
Filenames are James 07-13-21.pdf, R.Ricci 07-13-21.pdf and ect....

Any ideas?

Thank you

 

[earthworm]

Step 1 : Use Below Macro to select directory to list all File names present the particular folder

Sub GetFileNames1()

' To extract File names from Folder
     
    Range("A1").Select
        Dim xRow As Long
    Dim xDirect$, xFname$, InitialFoldr$
     
    InitialFoldr$ = "G:\" '<<< Startup folder to begin searching from
     
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = Application.DefaultFilePath & "\"
        .Title = "Please select a folder to list Files from"
        .InitialFileName = InitialFoldr$
        .Show
        If .SelectedItems.Count <> 0 Then
            xDirect$ = .SelectedItems(1) & "\"
            xFname$ = Dir(xDirect$, 7)
            Do While xFname$ <> ""
                ActiveCell.Offset(xRow) = xFname$
                xRow = xRow + 1
                xFname$ = Dir
            Loop
        End If
    End With
End Sub

Step 2 : This macro will create subfolder inside the select folder

Sub Createsubfolder2()

' To create Sub folder

Dim x As Integer
For x = 1 To 4

Dim reference As String
reference = Worksheets("Sheet1").Range("C" & x).Value
If reference < 2 Then

Dim name As String
name = Worksheets("Sheet1").Range("B" & x).Value

Dim directory As String
directory = Worksheets("Sheet1").Range("D1").Value

' To MkDir directory & name

  MkDir directory & name

Else
End If
Next x
End Sub

In order to make the above macro work
select new sheet by the name of Book1

Insert below Formula in Cell B1

=MID(A1,1,FIND(" ",A1,1))

Insert Below Formula in Cell C1

=COUNTIF(B$1:B1,B1)

Insert below value in Cell D1

C:\Users\Username*\Desktop\New folder\
* Make changes in above as per your PC login credentials

However You cannot push the PDF file into the sub folder if they are already present. Unless you need to export from Excel to those specific folder.