Moving Excel files into folder based on filename

[Jow]

At the moment I am using code to loop through all Excel files within a folder and perform a macro on each one in turn.

In addition to this, I want to be able to move each file into a specific folder based on their filename.

So within an excel macro, is it possible to move a file into a specific folder if it contains the word "Bankhill" for example?

All files containing the literal "Bankhill" in their filename would go into the "Bankhill" folder, all files containing the literal "Lite" in their filename would go into the "Lite" folder etc...

I have tried doing something similiar in VB.net and also with some windows scripting languages but I haven't really got anywhere, in any case it really needs to be executed from Excel so it works in conjunction with all my other macros.

Hope someone can help me out with some code? This is really holding me back from creating an effective automated system...

[tstav]

Would this be a rough psuedocode draft of what you want to do?

Check out the statement "Name" in Help for details (in case your folders are in the same or different drives etc.)


Sub MoveFilesToSameNameFolder()
For Each File In Folder
Select Case
Case InStr(1, File, "Bankhill", vbTextCompare) > 0
Name Folder & "\" & File, "C:\Bankhill\" & File
Case InStr(1, File, "Lite", vbTextCompare) > 0
Name Folder & "\" & File, "C:\Lite\" & File
End Select
Next
End Sub

[Jow]

Yeah that's exactly it...

[tstav]

Ok then,
give it a shot and post back. Lots of members will be here to help with any difficulties...
Gotta go now. I'll be back in about 2 hours.

Regards,
tstav

[Jow]

I've just been experimenting using that pseudocode as a basis but I'm really not getting anywhere! Can anyone give me a hand with it?

[Bob Phillips]

Post what you have already and we can add the moving bit (but it seems to me that you already have it).

[Jow]

Well I was trying to decide whether it would be best to grab the filename from the sheetname and put it into cell B1 using...



Range("B1").Select
ActiveCell.FormulaR1C1 = _
"=CELL(""filename"")"


And then use InStr on cell B1 to say if it contains "bankhill" then move the current file to "Bankhill" folder.
The problem with that method is that it means trying to move the file that is currently open, is it possible to do that?

Or whether it's best to use the "For Each File In Folder" method as tstav suggested. I wasn't sure how to even start that, so I didn't really get past the pseudocode...if someone could give me a hand with that it'd be good.
I googled how to move files and got this -


Set fso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
fso.movefile Source:=vaFileName, Destination:=[Newdir &"\backup1.xls"]
Set fso = Nothing

But wasn't sure how to implement it or even if it was what I wanted.

By the way, let me know if I'm not making any sense and I'll clarify :p

[Bob Phillips]

That seems unnecessarily complex to me. Just test the sheetname direct. Why bother opening it, it is not required is it. You could use tstav's code, or I would use Like



Sub LoopFolder()
Const SourceFolder As String = "C:\MyTest"
Dim oFSO
Dim oFolder As Object
Dim oFile As Object
Dim NewFolder As String
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(SourceFolder)
For Each oFile In oFolder.Files
If oFile.Type Like "*Microsoft Excel*" Then
Select Case True
Case oFile Like "*Bankhill*"
NewFolder = "C:\Bankhill\"
Case oFile Like "* Lite*"
NewFolder = "C:\Lite\"
'etc
End Select
Name oFolder & "\" As NewFolder & oFile.Name
End If
Next oFile
Set oFolder = Nothing
Set oFSO = Nothing
End Sub

[Jow]

Well the reason I mentioned the files being open is because I am already using this code...


Dim wb As Workbook
Dim TheFile As String
Dim MyPath As String
MyPath = ActiveWorkbook.Path
TheFile = Dir(MyPath & "\*.csv")



Do While TheFile <> ""
Set wb = Workbooks.Open(MyPath & "\" & TheFile)

...to cycle through all the workbooks in the folder to automatically run code within each one. This saves me opening up each workbook in turn to apply macros to them.

So I was considering performing the filemove instruction as each file individual file is opened, but it seems to me that it won't be possible to move the file while Excel has it open.

The way you have suggested seems alot better than what I had in mind...

I'll try it out now, thanks.

[Jow]

Sorry for the double post.

This is what I tried...



Sub LoopFolder()
Const SourceFolder As String = "C:\Users\ianlane\Desktop\test bucket"
Dim oFSO
Dim oFolder As Object
Dim oFile As Object
Dim NewFolder As String

Set oFSO = CreateObject("Scripting.FileSystemObject")

Set oFolder = oFSO.GetFolder(SourceFolder)

For Each oFile In oFolder.Files

If oFile.Type Like "*Microsoft Office Excel Comma Separated Values*" Then
Select Case True
Case oFile Like "*Bankhill*"
NewFolder = "C:\Users\ianlane\Desktop\test bucket\Bankhill\"
Case oFile Like "*Lite*"
NewFolder = "C:\Users\ianlane\Desktop\test bucket\Lite\"
'etc
End Select
Name oFolder & "\" As NewFolder & oFile.Name
End If
Next oFile

Set oFolder = Nothing
Set oFSO = Nothing

End Sub


...but nothing is happening when i run it. It is running the code because at first I had a couple of errors pop up, for example I forgot to change the file type to comma seperated values.

Now I get no errors but none of the files move, do you have any ideas for anything I can try?

[tstav]

filename is missing in source path

Name oFolder & "\" & oFile.Name As NewFolder & oFile.Name

[Bob Phillips]

filename is missing in source path

Name oFolder & "\" & oFile.Name As NewFolder & oFile.Name

No, I used the wrong variable, it should have been



Name oFile As NewFolder & oFile.Name


as that carries the path and name. But better to be explicit IMO



Name oFile.Path As NewFolder & oFile.Name


even though it is a poor property name

[Jow]

No luck, still not doing anything!

Just in case I'm doing something stupid and not realising it...I have a folder on my desktop called 'test bucket' "C:\Users\ianlane\Desktop\test bucket" and within that folder I have two subfolders named "Bankhill" and "Lite".
Within the test bucket I have these test files -

21-07-83 Bankhill ?12.84.csv
Bankhill ?65.23.csv
Bankhill ?2000.67.csv
LH Lite ?42.81.csv

....looks like it should work?



Sub LoopFolder()
Const SourceFolder As String = "C:\Users\ianlane\Desktop\test bucket"
Dim oFSO
Dim oFolder As Object
Dim oFile As Object
Dim NewFolder As String

Set oFSO = CreateObject("Scripting.FileSystemObject")

Set oFolder = oFSO.GetFolder(SourceFolder)

For Each oFile In oFolder.Files

If oFile.Type Like "*Microsoft Office Excel Comma Separated Values*" Then
Select Case True
Case oFile Like "*Bankhill*"
NewFolder = "C:\Users\ianlane\Desktop\test bucket\Bankhill\"
Case oFile Like "*Lite*"
NewFolder = "C:\Users\ianlane\Desktop\test bucket\Lite\"
'etc
End Select
Name oFile.Path As NewFolder & oFile.Name
End If
Next oFile

Set oFolder = Nothing
Set oFSO = Nothing

End Sub

[Bob Phillips]

It works fine for me, I replicated your directory structure and it worked okay.

However, as you are sending it to a sub-directory, I would simplify it a bit




Sub LoopFolder()
Const SourceFolder As String = "C:\Users\ianlane\Desktop\test bucket\"
Dim oFSO
Dim oFolder As Object
Dim oFile As Object
Dim NewFolder As String
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(SourceFolder)
For Each oFile In oFolder.Files
If oFile.Type Like "*Comma Separated Values*" Then
Select Case True
Case oFile Like "*Bankhill*"
NewFolder = "Bankhill\"
Case oFile Like "*Lite*"
NewFolder = "Lite\"
'etc
End Select
Name oFile.Path As SourceFolder & NewFolder & oFile.Name
End If
Next oFile
Set oFolder = Nothing
Set oFSO = Nothing
End Sub

[Bob Phillips]

BTW, do those sub-directories exist, do you have any CSV files named so?

[Jow]

Hey, yeah I had the directories in place but for some reason it didn't seem to be working, just tried out the last bit of code you posted though and it worked perfectly! There's quite a lot I'll be able to do with that now, thanks alot for your help!