move file macro

daveofgv

New Member
Joined
Apr 8, 2011
Messages
30
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
 

Some videos you may like

Excel Facts

Using Function Arguments with nested formulas
If writing INDEX in Func. Arguments, type MATCH(. Use the mouse to click inside MATCH in the formula bar. Dialog switches to MATCH.

Domenic

MrExcel MVP
Joined
Mar 10, 2004
Messages
19,406
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.

Code:
[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

MrExcel MVP
Joined
Mar 10, 2004
Messages
19,406
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

New Member
Joined
Apr 8, 2011
Messages
30
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

MrExcel MVP
Joined
Mar 10, 2004
Messages
19,406

ADVERTISEMENT

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

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

with

Code:
[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

New Member
Joined
Apr 8, 2011
Messages
30
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

New Member
Joined
Apr 8, 2011
Messages
30

ADVERTISEMENT

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

MrExcel MVP
Joined
Mar 10, 2004
Messages
19,406
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....

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

It Column A contains a header, replace...

Code:
Header:=xlGuess

with

Code:
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

New Member
Joined
Apr 8, 2011
Messages
30
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

MrExcel MVP
Joined
Mar 10, 2004
Messages
19,406
Try replacing...

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

with

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

Watch MrExcel Video

Forum statistics

Threads
1,123,158
Messages
5,600,054
Members
414,357
Latest member
Gemma_R

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top