Move files in different folder based on file name

[getuday]

Hello All,
I have many zip files in one folder and that need to be placed in different folder depending on the file name. what i want is that zip file should move to different folder where the folder name exist or maybe new folder should be created.
For example if the file name is R189_2282_LME and R189_4252_OME .... it will go in folder 2282 & 4252.
I had seen the code in the following thread
http://www.mrexcel.com/forum/showthread.php?t=446664
I modified it and the following code which is working fine..but its still incomplete.
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 = "E:\Move\Output\"
fromPath = "E:\Move\Input\"
Restart:
If Cnt > 1 Then Exit Sub
fName = Dir(fromPath & "*.zip")
Do While Len(fName) > 0
If Cnt > 1 Then Exit Sub
Cnt = 0
If Len(Dir(toPath & Mid(fName, 6, 4), vbDirectory)) = 0 Then
MkDir toPath & Mid(fName, 6, 4)

'If Len(Dir(toPath & Right(fName, Len(fName) - 5), vbDirectory)) = 0 Then
'MkDir toPath & Right(fName, Len(fName) - 5)

End If
Name (fromPath & fName) As (toPath & Mid(fName, 6, 4) & "\" & fName)

'Name (fromPath & fName) As (toPath & Right(fName, Len(fName) - 5) & "\" & fName)

fName = Dir
Loop
Cnt = Cnt + 1
GoTo Restart
End Sub

What I need is 2 things
1) If the number after the file name is of 5 or 6 digit. the winzip file should move in that folder or new folder should be created. For example the file name is R189_2282, the folder name should be 2282, if the file name is R189_26932, the folder name should be 26932, if the file name is R189_398465, the folder name should be 398465.

2) When the winzip file is getting pasted it should create the current month folder in that path and paste itself in that folder. For example it will be like e:\xxx\2282\July'11

Please help me in this coding.

 

[getuday]

Anybody has any reply for the above query.........

 

[jbeaucaire]

I'm pretty sure this is all you need:

Option Explicit

Sub MoveFiles()
'JBeaucaire  (7/31/2011)
'Moves ZIP files from one folder to another based on filename
Dim fName As String, fromPath As String, toPath As String
Dim MyArr As Variant

On Error Resume Next
toPath = "C:\2013\Output\"
fromPath = "C:\2013\Input\"

fName = Dir(fromPath & "*.zip")

Do While Len(fName) > 0
    MyArr = Split(fName, "_")
    MkDir toPath & MyArr(1) & "\"
    MkDir toPath & MyArr(1) & "\" & Format(Date, "MMMM'YY") & "\"
    Name (fromPath & fName) As (toPath & MyArr(1) & "\" & Format(Date, "MMMM'YY") & "\" & fName)
        
    fName = Dir
Loop

End Sub

 

[getuday]

Hi jbeaucaire,

That was fantastic, it’s working now. You are simply great. Can you if possible please explain the program? How it work step by step. I am very eager to learn it. Also the <?xml:namespace prefix = st1 ns = "urn:schemas-microsoft-comffice:smarttags" /><st1lace w:st="on"><st1:City w:st="on">Split</st1:City></st1lace> function which you have used.
<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o> </o>
Thanks again.
You have made my day. J

 

[jbeaucaire]

Here's the code again with comments added:

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
Dim MyArr As Variant

On Error Resume Next            'if directories exist, keep going
toPath = "C:\2013\Output\"      'source folder
fromPath = "C:\2013\Input\"     'main destination folder

fName = Dir(fromPath & "*.zip") 'get the first zip filename

Do While Len(fName) > 0
    MyArr = Split(fName, "_")       'create an array of words splitting the filename at the "_" characters
    MkDir toPath & MyArr(1) & "\"   'use the second word in the array to create a folder (0 is first word)
    MkDir toPath & MyArr(1) & "\" & Format(Date, "MMMM'YY") & "\"   'add the current month in dest folder
    Name (fromPath & fName) As (toPath & MyArr(1) & "\" & Format(Date, "MMMM'YY") & "\" & fName) 'move file
        
    fName = Dir                 'get the next filename
Loop

End Sub

 

[getuday]

Hi JBeaucaire,

Thanks a lot..can you tell me where in the programming it tell that if folder is already there just paste the zip files in that folder.

Thanks & Regards,
Uday

 

[jbeaucaire]

The two lines of code MkDir are making the directories, or attempting to. At the top of the macro I put in On Error Resume Next which causes the macro to keep going if one line of code errors. The only error that should occur is that some of these directories might already exist, so if the MkDir encounters an existing folder, it just keeps going.