Moving Excel files into folder based on filename

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

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

Code:

---

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

---

Yeah that's exactly it...

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

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?

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

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

Code:

---

    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 -

Code:

---

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

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

Code:

---

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

---

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

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.

Sorry for the double post.

This is what I tried...

Code:

---

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?

filename is missing in source path

Code:

---

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

---

Quote:

---

Originally Posted by tstav

filename is missing in source path

Code:

---

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

---

---

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

Code:

---

Name oFile As NewFolder & oFile.Name

---

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

Code:

---

Name oFile.Path As NewFolder & oFile.Name

---

even though it is a poor property name

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?

Code:

---

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

---

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

Code:

---


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

---

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

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!