Move all files from a folder to the most recently created sub folder in another destination

Dear members,

I am really new to this so have been tearing my hair for the last 3 days , trying to achieve something.

There is a source folder in which we create files (.jpg, .pdf, .tiff). That folder is always the same and it doesn't contain subfolders.

The destination folder is a bit more complex:

It is created by using the macro from my other Thread here (works very well but needs some cosmetic tweaking),

That existing macro is attached to a button and when a cell is selected (in column containing names of companies) and button pushed, it creates in a folder "Customers" a subfolder with the mane of that customer plus two sub_sub folders, Jobsheets" being the most recently created sub_sub folder.

The structure looks like that:

Customers
└───Company 1
│   └───Orders
│   └───Jobsheets
└───John Smith
│   └───Orders
│   └───Jobsheets
```

So the sub folder .../Customers/ John Smith/ Jobsheets is the latest one.

What I need is addition to the existing macro that moves all files form the source to the latest created /Jobsheets sub_subfolder, doesn't matter in which customers' name folder it is.

The purpose for all that is:

We have a big number of paper jobsheets that need scanning and a spreadsheet containing the customers names.

We scan few jobsheets for Company 1 to folder called scans. Then we press the button inside the spreadsheet, it creates 3 folders for that customer, and moves all scanned docs to the latest created one. Then we repeat the procedure for the next customer, John Smith.

Thanks in advance, that will clear a big mess that I have inherited.

Hello,

I don't have access to the machine where that file is but I am using a variation of this Macro:

Private Sub CommandButton1_Click()
Dim FolderPath As String
    If Not Application.Intersect(ActiveCell, Range("A:A")) Is Nothing Then
        If ActiveCell.Hyperlinks.Count = 0 Then
            'Main folder path
            FolderPath = "C:\Users\" & Environ("Username") & "\Desktop\Customers\"

            'Make the directory assuming the Quotes folder is already existing
            MkDir FolderPath & ActiveCell.value

            'Make the sub directory Costings
            MkDir FolderPath & ActiveCell.value & "\Orders"

            'Make the sub directory Reference
            MkDir FolderPath & ActiveCell.value & "\Jobsheets"

            'Create hyperlink
            ActiveSheet.Hyperlinks.Add Anchor:=ActiveCell, Address:=FolderPath & ActiveCell.value
        End If
    End If
End Sub

It also makes a hyperlink in the chosen cell.

It works! It works! Thank you very much yongle!

My problem is resolved.

I did notice that if we run the action and already have the folders generated but there was nothing in the source, and then we scan things and run it again, it breaks it. If the folders are deleted and the hyperlink removed though, then it works again. That is not concern because our routine needs to be the same and if we follow it, it works absolutely flawlessly.

Some extras that I think might make it more awesome:

Could be beneficial if instead of the hyperlink being created on the text in the selected cell, to be in another cell, let's say in D column on the same row.

Also to see the resulting path visible as text: "C:\Users\"Username\Desktop\Customers\John Smith" still hyperlinked but just to the customer's name level, not the subfolders .

The last thing was my original request form the other Thread, is it possible to add the name of the customer to the names of the folders "Orders" and "Customers".

Kindest Regards!

P.S. Just a thought, I have nor tried it with network folders, have to do that at work, but even if it doesn't work, we can always run it locally on the server's Excel and point to the relevant folders there!

Thanks for your persistence.

Yes, the way you have done it works perfectly and it is usable. I am really happy. From my perspective it works flawlessly.

The behaviour that I have mentioned is observed only if we don't follow the routine of Operator to scan files, then select cell, click button -> Excel creates folders, subfolders, creates hyperlink, moves files, etc.

I noticed it when I forgot to put files into the source. Then it makes the actions but no files are moved. When clicked again, even if we put files in the source it doesn't work because we have few things not right. One being that we already have the folders and subfolders created and another being the hyperlink generated. If need be, I will just delete the folders, clear hyperlink and it works. That is OK to me because prevents errors as folder replacement, overwriting etc. Also after we do that procedure once we will never do it again for any of the existing customers. This is just to digitise existing (thousands) of jobsheets written by hand, there is valuable information on them like specs, prices etc. After we finish, all will be done via CRM system.

Regards, Georgi

Yes, technical error, sorry. The word can be anything really, it is the method that I am interested in.

Quote from yongle

Test this

Code

replace:
ActiveSheet.Hyperlinks.Add Anchor:=ActiveCell, Address:=FolderPath & ActiveCell.Value

with:
ActiveSheet.Hyperlinks.Add Anchor:=Range("D" & ActiveCell.Row), Address:=FolderPath & ActiveCell, TextToDisplay:=FolderPath & ActiveCell

This works well, thanks.

Quote from dangelor

Another solution...

Code

Private Sub CommandButton1_Click()
    Dim FSO As Object, FolderPath As String, SourcePath As String
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    FolderPath = Environ("UserProfile") & "\Desktop\Customers\"
    SourcePath = Environ("UserProfile") & "\Desktop\Scans*"
    
    If Not Application.Intersect(ActiveCell, Range("A:A")) Is Nothing Then
        If Dir(FolderPath, vbDirectory) = vbNullString Then
            FSO.createfolder FolderPath
            FSO.createfolder FolderPath & ActiveCell.Value
            FSO.createfolder FolderPath & ActiveCell.Value & "\Orders"
        ElseIf Dir(FolderPath & ActiveCell.Value, vbDirectory) = vbNullString Then
            FSO.createfolder FolderPath & ActiveCell.Value
            FSO.createfolder FolderPath & ActiveCell.Value & "\Orders"
        End If
        
        If ActiveCell.Hyperlinks.Count = 0 Then
            ActiveSheet.Hyperlinks.Add Anchor:=ActiveCell, Address:=FolderPath & ActiveCell.Value
        End If
        
        FSO.CopyFolder SourcePath, FolderPath & ActiveCell.Value
        Name FolderPath & ActiveCell.Value & "\Scans" As FolderPath & ActiveCell.Value & "\JobSheets"
    End If
End Sub

Display More

Thank you dangelor,

This works as per my original request in this thread with the exception that it copies the folder scans to customers/nameofcustomer/ as scans and then renames it to jobsheets. That result is not suitable because we need all the content of scans to be moved to jobsheets. If I replace

FSO.CopyFolder SourcePath, FolderPath & ActiveCell.Value
With
FSO.MoveFolder SourcePath, FolderPath & ActiveCell.Value

it works but removes the folder scans from the Desktop. That means that for the next cycle of scans we will need to create it again so the scanner send them there automatically.

Interesting solution though, quite spoilt for choice with two different ways to resolve the same problem.

Quote from yongle

You could prevent the folders being created if the source folder is empty when the macro is run

Put something like this early in the Command Button procedure

Code

    If Dir("folder\subfolder\sourcefolder\*.*") = "" Then
        MsgBox "Source contains no visible files"
        Exit Sub
    End If
        
    MsgBox "carry on"
    code to create folders goes here

That also works well, thank you!

Thanks again, a summary of my observations:

This one works:

Quote from yongle

MkDir FolderPath & ActiveCell.Value & "\Orders" & " - " & ActiveCell.Value

This one returns Compile Error: Expected name of statement.

Quote from yongle

MkDir FolderPath & ActiveCell.Value & "\Jobsheets" " - " & ActiveCell.Value

Changed to:

MkDir FolderPath & ActiveCell.Value & "\Jobsheets" & " - " & ActiveCell.Value

So it creates the subfolders "Scans - nameofcustomer" but it doesn't move the actual scanned files from the source.

The error is "File not found" and it highlights Name oldPath & StrFile As newPath & StrFile

I imagine that the string insertion breaks the path.

This is the code so far, :

Private Sub CommandButton2_Click()
Dim FolderPath As String
 If Not Application.Intersect(ActiveCell, Range("A:A")) Is Nothing Then
 If ActiveCell.Hyperlinks.Count = 0 Then
 'Main folder path
 FolderPath = "C:\Users\" & Environ("Username") & "\Desktop\Customers\"
 'Makes the directory assuming the Customers folder is already existing
 MkDir FolderPath & ActiveCell.Value
 'Makes the sub directory Orders
 MkDir FolderPath & ActiveCell.Value & "\Orders" & " - " & ActiveCell.Value
 'Makes the sub directory Job Sheets
 MkDir FolderPath & ActiveCell.Value & "\Jobsheets" & " - " & ActiveCell.Value
 Call MoveFiles("C:\Users\" & Environ("Username") & "\Desktop\scans\", FolderPath & ActiveCell.Value & "\Jobsheets\")
 'Creates hyperlink
 ActiveSheet.Hyperlinks.Add Anchor:=Range("D" & ActiveCell.Row), Address:=FolderPath & ActiveCell, TextToDisplay:=FolderPath & ActiveCell
 End If
 End If
End Sub

'checks for empty scans folder
Private Sub MoveFiles(oldPath As String, newPath As String)
 
 If Dir("C:\Users\" & Environ("Username") & "\Desktop\scans\*.*") = "" Then
 MsgBox "You didn't scan any new files, did you?"
 Exit Sub
 End If
 
 MsgBox "Scans copied OK, please scan new Job Sheets for the next customer."
  
 Dim StrFile As String
 StrFile = Dir(oldPath & "*.*")
 Do While Len(StrFile) > 0
 Name oldPath & StrFile As newPath & StrFile
 StrFile = Dir
 Loop
End Sub