if the file name are matched with folder name file auto move into the folder

[shariq]

hello excel expert first of all iam happy to contact with you on messenger i from from pakistan english is not my laguage so please try to understand my problem ... i need a program if file name are matching folder name file auto move into the folder i have 10thousand above folder in my pc and also i have some document in my pc hope u understand my problem .. some example of folder

09141 Atif Ali Shah
09142 John David
09143 Micheal Jackson

some example of documents

09141 Atif Ali Shah
09142 Johan David
09143 Micheal Jackson

 

[John_w]

Looking at your screenshot, my understanding is that you want to move files from the Downloads folder to the matching subfolder in the Pictures folder, if that subfolder exists.

See if this macro works for you.

Public Sub Move_Files_To_Matching_Folder()
    
    Dim sourceFolder As String, destMainFolder As String, destSubfolder As String
    Dim FSO As Object
    Dim FSfile As Object
    Dim FSsourceFolder As Object
    
    sourceFolder = Environ$("USERPROFILE") & "\Downloads\"
    destMainFolder = Environ$("USERPROFILE") & "\Pictures\"

    If Right(sourceFolder, 1) <> "\" Then sourceFolder = sourceFolder & "\"
    If Right(destMainFolder, 1) <> "\" Then destMainFolder = destMainFolder & "\"

    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    Set FSsourceFolder = FSO.GetFolder(sourceFolder)
    For Each FSfile In FSsourceFolder.Files
        destSubfolder = destMainFolder & Left(FSfile.Name, InStrRev(FSfile.Name, ".") - 1) & "\"
        If FSO.FolderExists(destSubfolder) Then
            If FSO.FileExists(destSubfolder & FSfile.Name) Then FSO.DeleteFile destSubfolder & FSfile.Name, True
            FSfile.Move destSubfolder
        End If
    Next

End Sub

 

[shariq]

iam so happy and very very thankfull to you thank you very much specialy thanks for johan and mrexcel plat form thanks for help me its really working this code from my side 5 * rating review love this plat form .

 

[taimoor07]

Looking at your screenshot, my understanding is that you want to move files from the Downloads folder to the matching subfolder in the Pictures folder, if that subfolder exists.

See if this macro works for you.

Public Sub Move_Files_To_Matching_Folder()
   
    Dim sourceFolder As String, destMainFolder As String, destSubfolder As String
    Dim FSO As Object
    Dim FSfile As Object
    Dim FSsourceFolder As Object
   
    sourceFolder = Environ$("USERPROFILE") & "\Downloads\"
    destMainFolder = Environ$("USERPROFILE") & "\Pictures\"

    If Right(sourceFolder, 1) <> "\" Then sourceFolder = sourceFolder & "\"
    If Right(destMainFolder, 1) <> "\" Then destMainFolder = destMainFolder & "\"

    Set FSO = CreateObject("Scripting.FileSystemObject")
   
    Set FSsourceFolder = FSO.GetFolder(sourceFolder)
    For Each FSfile In FSsourceFolder.Files
        destSubfolder = destMainFolder & Left(FSfile.Name, InStrRev(FSfile.Name, ".") - 1) & "\"
        If FSO.FolderExists(destSubfolder) Then
            If FSO.FileExists(destSubfolder & FSfile.Name) Then FSO.DeleteFile destSubfolder & FSfile.Name, True
            FSfile.Move destSubfolder
        End If
    Next

End Sub

Hi John. This is perfect. Can you please help me on my query its quite similar to this one. I have recently posted the thread. Your help will be highliy appreciated.

 

[shariq]

hi john i need your help again how i can change destination folder ? "\Pictures\" this perfctly working but i could changes like this "\Employee file\" this is not working please share with me any solution please

 

[John_w]

Downloads and Pictures are standard user folders, hence why destMainFolder = Environ$("USERPROFILE") & "\Pictures\" should work on any Windows computer for any user.

If "Employee file" is a subfolder of a standard user folder, e.g. Documents then you could use:

destMainFolder = Environ$("USERPROFILE") & "\Documents\Employee file\"

Otherwise specify the full folder path:

destMainFolder = "C:\folder\path\to\Employee file\"

 

[shariq]

hi john boss i need your help again i can face some issue about script please help me i want to move file from download directory to another location ill try many time but not working look this ..
my source folder is "\Downloads\"
and my destination folder is "\D:\employee.records\desktop\backup by immad\"

i can try this but still not working please find out mistak and share with me .




Public Sub Move_Files_To_Matching_Folder()

Dim sourceFolder As String, destMainFolder As String, destSubfolder As String
Dim FSO As Object
Dim FSfile As Object
Dim FSsourceFolder As Object

sourceFolder = Environ$("USERPROFILE") & "\Downloads\"
destMainFolder = Environ$("USERPROFILE") & "\D:\employee.records\desktop\backup by immad\"

If Right(sourceFolder, 1) <> "\" Then sourceFolder = sourceFolder & "\"
If Right(destMainFolder, 1) <> "\" Then destMainFolder = destMainFolder & "\"

Set FSO = CreateObject("Scripting.FileSystemObject")

Set FSsourceFolder = FSO.GetFolder(sourceFolder)
For Each FSfile In FSsourceFolder.Files
destSubfolder = destMainFolder & Left(FSfile.Name, InStrRev(FSfile.Name, ".") - 1) & "\"
If FSO.FolderExists(destSubfolder) Then
If FSO.FileExists(destSubfolder & FSfile.Name) Then FSO.DeleteFile destSubfolder & FSfile.Name, True
FSfile.Move destSubfolder
End If
Next

End Sub

 

[John_w]

Please use VBA code tags.

sourceFolder = Environ$("USERPROFILE") & "\Downloads\"
destMainFolder = Environ$("USERPROFILE") & "\D:\employee.records\desktop\backup by immad\"

The environment variable USERPROFILE resolves to "<drive letter>:\Users\theUsername", for example "C:\Users\User123".

Therefore your sourceFolder line is correct, but not your destMainFolder line.

For the subfolder of the user's Desktop folder use:

    destMainFolder = Environ$("USERPROFILE") & "\Desktop\backup by immad\"

 

[shariq]

jhon can you share with me full script i can not understand if u share with me then i can just copy and past in a vba .

 

[John_w]

You've already posted the full script. I'm saying that the destMainFolder line is incorrect (because of the "\D:\" in the middle of the string, for one thing).

Therefore, replace:

destMainFolder = Environ$("USERPROFILE") & "\D:\employee.records\desktop\backup by immad\"

with:

destMainFolder = Environ$("USERPROFILE") & "\Desktop\backup by immad\"