if the file name match with folder name file auto move into the folder

[shariq]

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

this script give me john this is perfctly working but i have a some problm i want to change the desination folder how i can chage beacuse i'll try like this destMainFolder = Environ$("USERPROFILE") & "\Employee file\" but this not working any body help me

 

[John_w]

I answered in your original thread -

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

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...

www.mrexcel.com

Admins - please close this thread.

 

[shariq]

i really thank full to you john your solve my problem thanks alot all vba script are prefctly worrking many many thankful to you and mr excel borad

 

[Fluff]

In future, please do not post the same question multiple times. Per Forum Rules (#12), posts of a duplicate nature will be locked or deleted.