Move files to diff folders based on filename

[THEMAN]

Hi All

Is there some code out there that can move all the excel files based on filename on my desktop to existing folder with the same name eg folder name is dog, files on my desktop is dog.xls and folder name is cat, files on my desktop is cat.xls

I have muitlple files and I don;t want to manually move them one by one.

Thanks in advanced.

 

[jbeaucaire]

1) Do these folders already exist or do they need to be created based on all the Excel files found on your desktop?

2) What path are they being created in? (or exist in already?)

"C:\My Documents\Excel\Dog\"
"C:\My Documents\Excel\Cat\"

 

[jbeaucaire]

This little macro will move all the XLS files from the desktop into a folder of the same name in the designated toPath.

If the folder doesn't exist already, the macro will create it.

Option Explicit

Sub MoveFiles()
'JBeaucaire  (2/6/2010)
'Moves files from the desktop into folders of their own
Dim fName As String, fromPath As String, toPath As String, Cnt As Long
On Error Resume Next

toPath = "C:\Test1\"
fromPath = "C:\Documents and Settings\Jerry\Desktop\"

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

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

Cnt = Cnt + 1
GoTo Restart

End Sub

 

[THEMAN]

Thanks jbeaucaire that will be useful in future, however the folders already exist, move to the same folder name?

 

[jbeaucaire]

This macro works in either case.

 

[rotciv]

Hi jbeaucaire,

Just tried your macro and it works great!
I have a similar task that I'm trying to accomplish but I'm still a newbie with VBA and very interested in learning more! Tried rewriting your code but didn't get it to work and still grasping the left() and right() functions.
The code is probably simpler than I'm trying to make it.

I have about 500 .pdf files in the fromPath. Here are some filename examples:
10012345.pdf
10022222.pdf
20012345.pdf
20011111.pdf
20112345.pdf
20212345.pdf

I will need to create subdirectories in the toPath according to just the first 3 digits of the filename and then moving (distributing) the file to that created directory. Thus from the example, Subfolder 100 will have 2 files, subfolder 200 will have the 2 files listed, and so on.

Any help would greatly be appreciated!
Rotciv

 

[jbeaucaire]

Try this:

Option Explicit

Sub MoveFiles()
'JBeaucaire  (4/8/2010)
'Moves files from the desktop into folders of their own
'Create subfolders as needed based on first 3 characters of each filename
Dim fName As String, fromPath As String, toPath As String
Dim toSubPath As String, Cnt As Long
On Error Resume Next

toPath = "C:\Test1\"
fromPath = "C:\2010\"

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, 3) & "\"
    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

 

[rotciv]

jbeaucaire,

I just had a chance to try it and it worked beautifully.
I'm trying to understand the function of your Cnt variable.
Not too sure, but it looks like it ends the macro once all the
files have been moved.

Thank you so much for your help!!!

 

[jbeaucaire]

I'm sure there'e a more elegant way to deal with it, but the CNT variable is my way of dealing with how the DIR() listing gets messed up if you move any of the files that make up the current listing.

When a file is moved, the next DIR() comes up empty, so I need to restart the whole process. When I restart, CNT is incremented...usually from 0 to 1. If more files still exist to move, the macro continues and INSIDE the For/Next loop the CNT is set back to zero.

So, as long as there are files to move, the CNT will never be more than 1. But the first time it restarts and there are no more files to move, the For/Next loop is skipped and the CNT get incremented to 2. Since that is greater than 1, the macro aborts when it restarts again...the first line of code after Restart: aborts when the CNT is greater than 1.

 

[ActM11]

Jbeaucaire,<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
<o></o>
I wanted to say that I have used your macro several times and it works nicely.<o></o>
<o></o>
I'm now in needing a different approach and I would appreciate if you can give me an option for that.<o></o>
<o></o>
I have an excel file where one of the columns contains the image related to each particular product.<o></o>
I also have a folder with thousands of images, including the images of the products in the excel file.<o></o>
<o></o>
What I need is moving to a new directory only the images that are referenced in the excel file.<o></o>
Could you please help me on this?<o></o>
<o></o>
Thanks in advance<o></o>
Bill<o></o>