VB Code to move image files into their asociated folders identified in an excel spreadsheet

jamjam123

New Member
Joined
May 4, 2018
Messages
3
I have an excel spreadsheet which identifies where image files need to be moved.
At the moment all the image files are located in one large folder on my external hard drive f:\
So, I want to move all the images that correspond to the folder name which is recorded in excel spreadhseet
I have 3,093 folders with approximately 6,000 images.

I don't know programming. I found the script below but it asks for a source and destination folder. I have manually gotten through 300 folders but it's taking ages.
Would anyone be able to help me do this in one F5 run

Folder Name File Name
301
43310.tif
302
26189.tif
302
37000.tif
303
43205.tif
304
25866.tif
304
32694.tif

<colgroup><col><col></colgroup><tbody>
</tbody>


Sub copyfiles()
'Updateby Extendoffice
Dim xRg As Range, xCell As Range
Dim xSFileDlg As FileDialog, xDFileDlg As FileDialog
Dim xSPathStr As Variant, xDPathStr As Variant
Dim xVal As String
On Error Resume Next
Set xRg = Application.InputBox("Please select the file names:", "KuTools For Excel", ActiveWindow.RangeSelection.Address, , , , , 8)
If xRg Is Nothing Then Exit Sub
Set xSFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
xSFileDlg.Title = "Please select the original folder:"
If xSFileDlg.Show <> -1 Then Exit Sub
xSPathStr = xSFileDlg.SelectedItems.Item(1) & ""
Set xDFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
xDFileDlg.Title = "Please select the destination folder:"
If xDFileDlg.Show <> -1 Then Exit Sub
xDPathStr = xDFileDlg.SelectedItems.Item(1) & ""
For Each xCell In xRg
xVal = xCell.Value
If TypeName(xVal) = "String" And xVal <> "" Then
FileCopy xSPathStr & xVal, xDPathStr & xVal
End If
Next
End Sub
 

Some videos you may like

Excel Facts

Can a formula spear through sheets?
Use =SUM(January:December!E7) to sum E7 on all of the sheets from January through December

PatOBrien198

Board Regular
Joined
Sep 13, 2017
Messages
236
Maybe something like:


Code:
Sub CopyEm()

Dim strFolderFrom As String
Dim strFolderTo As String
Dim strFileName As String
Dim rngStart As Range
Dim r As Long

Set rngStart = Range("A1")  ' starting cell with folder names
strFolderFrom = "C:\whatever\folder\you\have\"

r = 1   ' to start with first row below A1

Do While rngStart.Offset(r, 0) <> ""
    strFolderTo = rngStart.Offset(r, 0) & "\"  ' add last back slash
    strFileName = rngStart.Offset(r, 1)      ' file name in B column
    FileCopy strFolderFrom & strFileName, strFolderTo & strFileName
    r = r + 1
Loop
MsgBox "Done", vbExclamation
 
End Sub
 
Last edited:

jamjam123

New Member
Joined
May 4, 2018
Messages
3
Thanks very much Pat,

I am getting Run-time error '53': File not found
When i debug it refers to line
FileCopy strFolderFrom & strFileName, strFolderTo & strFileName

I have entered strFolderFrom = F:\images

Am i missing something? Do i need to declare
FileCopy
FileCopy
 

PatOBrien198

Board Regular
Joined
Sep 13, 2017
Messages
236
Try adding a backslash....


Code:
strFolderFrom = "F:\images\"
To see the final values of the folder/file names... before the FileCopy statement put in..

Code:
msgbox "From=" & strFolderFrom & strFileName & vbcrlf & "To=" & strFolderTo & strFileName
Then make sure that the from and to have the correct paths with slashes.
 
Last edited:

jamjam123

New Member
Joined
May 4, 2018
Messages
3
HI Pat, many thanks for your help./ You're a legend...
Base don your feedback...

Sub CopyEm()

Dim strFolderFrom As String
Dim strFolderTo As String
Dim strFileName As String
Dim rngStart As Range
Dim r As Long

Set rngStart = Range("A1") ' starting cell with folder names
strFolderFrom = "F:\Images"

r = 1 ' to start with first row below A1

Do While rngStart.Offset(r, 0) <> ""
strFolderTo = "F:" & rngStart.Offset(r, 0) & "" ' add last back slash
strFileName = rngStart.Offset(r, 1) ' file name in B column
FileCopy strFolderFrom & strFileName, strFolderTo & strFileName
r = r + 1
Loop
MsgBox "Done", vbExclamation

End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,099,461
Messages
5,468,781
Members
406,608
Latest member
G3TEN

This Week's Hot Topics

Top