move file macro

[daveofgv]

I have a list of file names in column A (example: 54335343.tif)
I have one directory with about 40 or so subfolders where this image is located, however, I don't know which one unless I manually searched for it.

What I need is a macro to run where I can have a list of 200 or even 1000 file names (like the above example) and move only those file names to another folder. I don't want to move the whole directory - just the file names I have in the column.

I know how to move the whole directory and also file names, however, I only know how to hardcode the actual file path (which I don't know).

Anyone know how to have excel macro search for the file name in a directory and once it finds it that file will move to another given folder?

Also, I need another column to put a "1" or something next to the image that the move method cannot find.

Maybe also move the file name to another column instead of a "1".....

Is this possible and if so can anyone help me?

We are hiring temp workers at work so I need to make this simple for those that don't know computers that well....

Thanks in advanced

daveofgv

 

[Domenic]

Place the following procedures in a regular module, change the path for the source and destination folders (as indicated in green), make sure that the sheet containing the file names is the active sheet, and run the macro called "MoveFiles".

For each file in the source folder and its subfolders, the macro fills an array with the file name and its corresponding path. Then it loops through each cell in Column A. If the file name is found within the array, the file is moved to the destination folder. Otherwise, the number 1 is placed in the corresponding cell of Column B.

[font=Verdana][color=darkblue]Option[/color] [color=darkblue]Explicit[/color]

[color=darkblue]Sub[/color] MoveFiles()

    [color=darkblue]Dim[/color] objFSO [color=darkblue]As[/color] FileSystemObject
    [color=darkblue]Dim[/color] strSourceFolder [color=darkblue]As[/color] [color=darkblue]String[/color]
    [color=darkblue]Dim[/color] strDestFolder [color=darkblue]As[/color] [color=darkblue]String[/color]
    [color=darkblue]Dim[/color] arrMyFiles() [color=darkblue]As[/color] [color=darkblue]String[/color]
    [color=darkblue]Dim[/color] MatchVal [color=darkblue]As[/color] [color=darkblue]Variant[/color]
    [color=darkblue]Dim[/color] Cnt [color=darkblue]As[/color] [color=darkblue]Long[/color]
    [color=darkblue]Dim[/color] i [color=darkblue]As[/color] [color=darkblue]Long[/color]
    [color=darkblue]Dim[/color] LastRow [color=darkblue]As[/color] [color=darkblue]Long[/color]
    
    Application.ScreenUpdating = [color=darkblue]False[/color]
    
    [color=darkblue]Set[/color] objFSO = CreateObject("Scripting.FileSystemObject")
    
    [color=green]'Change the path to the source folder accordingly[/color]
    strSourceFolder = "C:\Users\Domenic\Desktop\SourceFolder\"
    
    [color=green]'Change the path to the destination folder accordingly[/color]
    strDestFolder = "C:\Users\Domenic\Desktop\DestFolder\"
    
    [color=darkblue]Call[/color] ProcessFolders(objFSO, strSourceFolder, arrMyFiles(), Cnt)
    
    LastRow = Cells(Rows.Count, "A").End(xlUp).Row
    
    [color=darkblue]For[/color] i = 1 [color=darkblue]To[/color] LastRow
        [color=darkblue]With[/color] Application
            MatchVal = .Match(Cells(i, "A").Value, .Index(arrMyFiles, 2, 0), 0)
            [color=darkblue]If[/color] IsError(MatchVal) [color=darkblue]Then[/color]
                Cells(i, "B").Value = 1
            [color=darkblue]Else[/color]
                objFSO.GetFile(.Index(arrMyFiles, 1, MatchVal) & "\" & .Index(arrMyFiles, 2, MatchVal)).Move strDestFolder
            [color=darkblue]End[/color] [color=darkblue]If[/color]
        [color=darkblue]End[/color] [color=darkblue]With[/color]
    [color=darkblue]Next[/color] i
    
    Application.ScreenUpdating = [color=darkblue]True[/color]
    
    MsgBox "Completed...", vbInformation
    
[color=darkblue]End[/color] [color=darkblue]Sub[/color]

Sub ProcessFolders([color=darkblue]ByRef[/color] FSO [color=darkblue]As[/color] FileSystemObject, [color=darkblue]ByVal[/color] SrcFldrName [color=darkblue]As[/color] [color=darkblue]String[/color], [color=darkblue]ByRef[/color] MyFiles() [color=darkblue]As[/color] [color=darkblue]String[/color], [color=darkblue]ByVal[/color] Cnt [color=darkblue]As[/color] [color=darkblue]Long[/color])

    [color=darkblue]Dim[/color] objFolder [color=darkblue]As[/color] Folder
    [color=darkblue]Dim[/color] objSubFolder [color=darkblue]As[/color] Folder
    [color=darkblue]Dim[/color] objFile [color=darkblue]As[/color] File
    
    [color=darkblue]Set[/color] objFolder = FSO.GetFolder(SrcFldrName)
    
    [color=darkblue]For[/color] [color=darkblue]Each[/color] objFile [color=darkblue]In[/color] objFolder.Files
        Cnt = Cnt + 1
        [color=darkblue]ReDim[/color] [color=darkblue]Preserve[/color] MyFiles(1 [color=darkblue]To[/color] 2, 1 To Cnt)
        MyFiles(1, Cnt) = objFolder
        MyFiles(2, Cnt) = objFile.Name
    [color=darkblue]Next[/color] objFile
    
    [color=darkblue]For[/color] [color=darkblue]Each[/color] objSubFolder [color=darkblue]In[/color] objFolder.SubFolders
        [color=darkblue]Call[/color] ProcessFolders(FSO, obj[color=darkblue]Sub[/color]Folder, MyFiles(), Cnt)
    [color=darkblue]Next[/color] objSubFolder
    
[color=darkblue]End[/color] Sub
[/font]

 

[Domenic]

I forgot to mention that you'll need to set up a reference to the Windows Script Host Object Model in the Visual Basic Editor...

Tools > References > Windows Script Host Object Model

 

[daveofgv]

This will check all subfolders within the directory also, correct?

And what part would I change if I need to copy instead of move?

Thanks in advanced

daveofgv

 

[Domenic]

This will check all subfolders within the directory also, correct?

Yes, that's correct...

And what part would I change if I need to copy instead of move?

Replace...

[font=Verdana] objFSO.GetFile(.Index(arrMyFiles, 1, MatchVal) & "\" & .Index(arrMyFiles, 2, MatchVal)).Move strDestFolder[/font]

with

[font=Verdana]objFSO.GetFile(.Index(arrMyFiles, 1, MatchVal) & "\" & .Index(arrMyFiles, 2, MatchVal)).Copy Destination:=strDestFolder, OverWriteFiles:=[color=darkblue]True[/color][/font]

Note that if a file already exists in the destination folder, the file in the destination folder is over-written.

 

[daveofgv]

Awsome! it works perfect!

When I copy the file and send it to the dest folder if there are multiple files on the spread sheet that are the same name is it hard to copy one of the files and mark the same name files with a "2"

Example:

test.txt
test1.txt
text.txt

where the second text.txt name has a 2 in column B?

Edited Part:
It's really not that big of a deal on this since I can always do a "remove duplicate"

Just curious

 

[daveofgv]

Question please:

It actaully only copies / moves one file from each subdirectory......

If I have 3 test files in one sub folder they all copy.
If I have 3 folders with 1 file in each folder it only copies one file.

What can I do to have this changed?

 

[Domenic]

Awsome! it works perfect!

When I copy the file and send it to the dest folder if there are multiple files on the spread sheet that are the same name is it hard to copy one of the files and mark the same name files with a "2"

Example:

test.txt
test1.txt
text.txt

where the second text.txt name has a 2 in column B?

Edited Part:
It's really not that big of a deal on this since I can always do a "remove duplicate"

Just curious

To remove duplicates from Column A, insert this line of code just after the one beginning with LastRow....

[font=Verdana]Range("A1:A" & LastRow).RemoveDuplicates Columns:=1, Header:=xlGuess
    [/font]

It Column A contains a header, replace...

Header:=xlGuess

with

Header:=xlYes

Question please:

It actaully only copies / moves one file from each subdirectory......

If I have 3 test files in one sub folder they all copy.
If I have 3 folders with 1 file in each folder it only copies one file.

What can I do to have this changed?

I don't quite understand... Can you please clarify?

 

[daveofgv]

I created 2 folders:
folder 1 is named "from"
folder 2 is named "to"

I put 3 folders in the "from" folder and added 1 file in each folder.

I ran the macro and only 1 file copied to the "to" folder.

I then put all 3 files in the same folder in the "from" folder and they all copied.

After I get my project completed and take to work on monday we will have to search through about 20 folders and copy 200-500 files.

If all the files are in the same folder I have no problem that they will all copy, however, it appears it will not copy all the files if they are in subfolders. It gets one and then says the other 2 can not be found (adds a 1 in column B and does not copy)

I hope this makes sense.....

 

[Domenic]

Try replacing...

Sub ProcessFolders(ByRef FSO As FileSystemObject, ByVal SrcFldrName As String, ByRef MyFiles() As String, ByVal Cnt As Long)

with

Sub ProcessFolders(ByRef FSO As FileSystemObject, ByVal SrcFldrName As String, ByRef MyFiles() As String, [COLOR="Red"]ByRef[/COLOR] Cnt As Long)