VBA code to automatically move files to subfolders based on a predefined list

[mkh862]

VBA code to automatically move files to subfolders based on a predefined list

I have a folder containing over 1000 files. I want to move these files to subfolders based on a predefined list in Excel that corresponds filenames to the name of the subfolders to which the file should be moved to, such as the example below:

table.png

Could anyone please develop a VBA code to do this?
Thanks so very much in advance.

[bakerman2]

Do all subfolders exist or does this need to be checked ?
Does Column A & Column B contain fullpath or only folder names ?
Does Colmumn A also has the file extensions in it ?
To give you an idea.

Please Login or Register  to view this content.

[mkh862]

Thanks Bakerman for your response.
-Subfolders do not exist. The code should also create the subfolders within the main folder.
-Columns A & B both contain only file and folder names and not the fullpath
-Column A does not have the file extension in it.

[bakerman2]

To summarize.
1) You have a starting folder holding all files f.i. "C:\Startfolder\"
2) Column A has all filenames without extension.
3) Column B has all required subfoldernames.

Your need
1) Find file in startfolder based on partial name in column A
2) Check if subfolder in Column B exists. If Yes move file to subfolder.
If Not create subfolder and move file.
3) Continue till list is finished in Column A.

[mkh862]

All correct

[bakerman2]

OK then try this.

Please Login or Register  to view this content.

[mkh862]

Thank you so much.I do not see the reply I had posted earlier, so here it is again:

"I made the necessary changes to suit, but running the code I get [Run time error 53: File not found] error."

[bakerman2]

Most likely you have a typo in 1 of the values in Column A because my tests showed no errors at all.

[mkh862]

Double checked it, the names match properly. I just can't figure our where it stems from.
I do not get the point about the annotation in line 15: [' move the file]. I do not change anything in this line. Could the error have something to do with this?

[bakerman2]

No, it's just to point out that this line actually does the moving.

Post your code as you rae using it now.

[mkh862]

Sub tst()
Dim fname As String
sn = Sheets("Sheet1").Cells(1).CurrentRegion.Value 'change Sheet1 to suit
Const StartFolder As String = "C:\subfolder_test\" 'change to correct startfolder
With CreateObject("scripting.dictionary")
For i = 2 To UBound(sn)
x0 = .Item(sn(i, 2))
Next
For Each it In .keys
CreateObject("shell.application").Namespace(StartFolder).NewFolder it
Next
End With
For i = 2 To UBound(sn)
fname = sn(i, 1): fname_ext = GetFullFileName(StartFolder, fname)
Name StartFolder & fname_ext As StartFolder & sn(i, 2) & "\" & fname_ext ' move the file
Next
End Sub

Function GetFullFileName(strfilepath As String, strFileNamePartial As String) As String
Dim objFile As Variant, strfilenamefull As String
With CreateObject("Scripting.FileSystemObject").GetFolder(strfilepath)
For Each objFile In .Files
If InStr(objFile.Name, strFileNamePartial) > 0 Then strfilenamefull = objFile.Name: Exit For
Next objFile
End With
GetFullFileName = strfilenamefull
End Function

[bakerman2]

Just tested again and the only time I can raise an error is when I put a wrong filename in column A.
When the error rises go to debug and hoover with your mouse pointer over sn(i,1) to see which value it has. Then you know which filename throws the error.

[msaedoar]

Hi,

Would like to revive this.
I have the same work to do with many files in one directory.

I am trying to run the VBA code from this tread but receive an error =

Run-time error '91'
Object variable or With block variable not set

-----

I am using latest version of excel 365 business edition.

Thanks

[alex5421]

thanks you solved my problem

[dangelor]

Possibly...

Please Login or Register  to view this content.