How to Move specific files to folders with VBA

Hello all,

I would like to move files from a specifice folder to several different folders with VBA.

The files i like to move are stored in a specific folder on C:\Material

The folder contains different kind of excel files that needs to be moved to different folders each month.

The beginning of the file name is always the same for each separate file but the month changes.

I have a listed the file names in excel and also the folder where to move.


Filen Name Location Correct Folder
AA MARCH 2012.XLS C:\Material C:\AA
BB MARCH 2012.XLS C:\Material C:\BB

Look for filename in A1 in excel sheet - Then look for it in C:\Material If found then Move to C:\AA
Then Goto next row in excel sheet A2 look for filename - Then if found in C:\Material then move to C:\BB
End Function


I ripped one from the internet:

Sub CopyFilesFolder2Folder()
Dim fso
Dim sfol As String, dfol As String
sfol = "c:\material" ' source folder path
dfol = "C:\destination" ' match the destination in column D1??
Set fso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
If Not fso.FolderExists(sfol) Then
****MsgBox sfol & " is not a valid folder/path.", vbInformation, "Invalid Source"
ElseIf Not fso.FolderExists(dfol) Then
****MsgBox dfol & " is not a valid folder/path.", vbInformation, "Invalid Destination"
Else
****fso.CopyFile (sfol & "\*.*"), dfol '  HOW to change to the file name in excel sheet B1??
End If
If Err.Number = 53 Then MsgBox "File not found"
End Sub

This doesn't create folders, but it will move the files if they exist in the paths as you have described:

Sub MoveFiles()
Dim cell As Range

    For Each cell In Range("A:A").SpecialCells(xlConstants)
        If Len(Dir(cell.Offset(, 1) & "\" & cell.Value)) > 0 Then
            Name cell.Offset(, 1) & "\" & cell.Value As cell.Offset(, 2) & "\" & cell.Value
            cell.Offset(, 3).Value = "moved"
        Else
            cell.Offset(, 3).Value = "not found"
        End If
    Next cell

End Sub