Macro move file to existing folder by name using filename first left7 digits with a space delimiter

[DeMoNloK]

I'm looking for some help. I started trying to use excel for this project yesterday.
I originally scripted a batch file to run this operation.
The batch works in a small and limited environment.
I tried the batch in a live folder and it was a complete failure with files being multiplied and moved into random folders.

My goal is to move 50+ new .pdf files created everyday using the first 7 digits and an accompanying space to match my Projects folder working structure.
all .pdf will start with a 7 digit number followed by a space between each date and name, the folder structure is set up using the 7 digit naming but has info about the project.
file example; 1234567 4-17-2021 name hr code.pdf Folder example; 1234567 projectName Date with a subfolder of service reports, the service report folder within the main project folder will house all incoming .pdfs'
The code below works, but will only work when the folder has only 7 digits. As soon as I rename the folder to match the naming scheme of the actual folder layout excel freezes and then crashes.
Any and all help will be appreciated.

[COLOR=rgb(41, 105, 176)]Sub MoveFiles()




Dim fName As String, fromPath As String, toPath As String, Cnt As Long
On Error Resume Next



toPath = "C:\Users\RyZeNx\Desktop\wip\"
fromPath = "C:\Users\RyZeNx\Desktop\test\"

Restart:
If Cnt > 1 Then Exit Sub
fName = Dir(fromPath & "*.pdf")

Do While Len(fName) > 4
    If Cnt > 1 Then Exit Sub
    Cnt = 0
    toSubPath = toPath & Left(fName, 7) & "\Service Reports\"
    If Len(Dir(toSubPath, vbDirectory)) = 0 Then MkDir toSubPath
    Name (fromPath & fName) As (toSubPath & fName)
    fName = Dir
Loop

Cnt = Cnt + 1
GoTo Restart



End Sub[/COLOR]

 

[Marc L]

To be sure the final folder is well created this thread may help :​

VB Code to move files based on its name

Hello: I have lots of pdf file in C:\Scannedfiles folder with following name standard. MM-DD-YYYY-StoreName-Category.pdf Example 05-09-2020-Store1-Utilies_Gas 04-29-2020-Store9-Insurance_WC

www.excelforum.com

 

[DeMoNloK]

To be sure the final folder is well created this thread may help :​

VB Code to move files based on its name

Hello: I have lots of pdf file in C:\Scannedfiles folder with following name standard. MM-DD-YYYY-StoreName-Category.pdf Example 05-09-2020-Store1-Utilies_Gas 04-29-2020-Store9-Insurance_WC

www.excelforum.com

The final folder is already created. I just don't know the right expression to have the move function to place file name in the corresponding folder name at the space after the 7 digit name. The space after numbers name is the delimiter, any text after 1234567 won't matter as long as the file is name the same as the folder so 1234567 name.pdf will go into folder 1234567 project\service report.

so what I'm seeing is between

toSubPath = toPath & Left(fName, 7) & [COLOR=rgb(184, 49, 47)]??????[/COLOR] & "\Service Reports\"

is a missing function

 

[DeMoNloK]

The final folder is already created. I just don't know the right expression to have the move function to place file name in the corresponding folder name at the space after the 7 digit name. The space after numbers name is the delimiter, any text after 1234567 won't matter as long as the file is name the same as the folder so 1234567 name.pdf will go into folder 1234567 project\service report.

so what I'm seeing is between

toSubPath = toPath & Left(fName, 7) & ???????????? & "\Service Reports\"

is a missing function

I see that I DO NOT need to create a directory because the folders already exist, looks like I need to figure out how to tell excel just to move the files based off name. Every time I rename the des folder to something I have at the office, excel crashes. I think do to the folder has a similar name but unable to the create a folder

 

[Marc L]

Just reading VBA help a beginner starter demonstration how to move a file if the destination folder already exists :​

Sub Demo1()
    Const FD = "C:\Users\RyZeNx\Desktop\test\", TD = "C:\Users\RyZeNx\Desktop\wip\"
      Dim F$, L&, S$(), P$
          F = Dir(FD & "*.pdf")
    While F > ""
        L = L + 1
        ReDim Preserve S(1 To L)
        S(L) = F
        F = Dir
    Wend
    For L = 1 To L
        P = TD & Split(S(L))(0) & "\Service Reports\"
        If Dir(P, vbDirectory) = "." Then If Dir(P & S(L)) = "" Then Name FD & S(L) As P & S(L)
    Next
End Sub

 

[DeMoNloK]

Just reading VBA help a beginner starter demonstration to move a file if the destination folder already exists :​

Sub Demo1()
    Const FD = "C:\Users\RyZeNx\Desktop\test\", TD = "C:\Users\RyZeNx\Desktop\wip\"
      Dim F$, L&, S$(1 To 1), P$
          F = Dir(FD & "*.pdf")
    While F > ""
        L = L + 1
        If L > 1 Then ReDim Preserve S(1 To L)
        S(L) = F
        F = Dir
    Wend
    For L = 1 To L
        P = TD & Split(S(L))(0) & "\Service Reports\"
        If Dir(P, vbDirectory) = "." Then If Dir(P & S(L)) = "" Then Name FD & S(L) As P & S(L)
    Next
End Sub

This is super greek, I have a lot to learn.

 

[DeMoNloK]

This is super Greek, I have a lot to learn.

I got a compile error with this new code, where are you sourcing the info from?

 

[Marc L]

​

My bad, see the updated code …​

 

[DeMoNloK]

​

My bad, see the updated code …​

It works when the folder is named only 1234567, but as soon as I rename folder to correct naming scheme 1234567 Project blue red green it doesn't move.
This is where things get confusing.

 

[DeMoNloK]

It works when the folder is named only 1234567, but as soon as I rename folder to correct naming scheme 1234567 Project blue red green it doesn't move.
This is where things get confusing. View attachment 36922View attachment 36923