Help to copy files names in a column from one directory to another directory VBA

P

Paul B

I have a list of picture names in a sheet named Search Results, Column C,
starting in C2, like DSCF0001, DSCF0002, ... that I want to copy them from
one directory to another directory, I have some code that will copy ALL the
pictures in the directory to the other one but how can I only copy the files
that are in column C. Here is the code to copy them all.

Thanks

Option Explicit
Sub CopyPictures()
Dim WSHShell As Object
Dim DesktopPath As String
Dim sSource As String
Dim sDestination As String
Dim fs As Object


Set WSHShell = CreateObject("WScript.Shell")
DesktopPath = WSHShell.SpecialFolders("Desktop")
Set WSHShell = Nothing

'Checks to make sure you have the carousels folder
If Dir(Application.DefaultFilePath & "\My Pictures\Carousels\") =
vbNullString Then
MsgBox "Can Not Fine The Directory" & Application.DefaultFilePath & "\My
Pictures\Carousels", , "Directory Error"
Exit Sub
End If

'checks to see if you have the Copy of Carousels folder on your desktop
'if not it will be made
If Dir(DesktopPath & "\Copy of Carousels", vbDirectory) = vbNullString Then
MkDir DesktopPath & "\Copy of Carousels"

'use if you only want jpg files
'sSource = Application.DefaultFilePath _
& "\My Pictures\Carousels\*.jpg"

'use to get all files
sSource = Application.DefaultFilePath _
& "\My Pictures\Carousels\*"

'the destination folder
sDestination = DesktopPath & "\Copy of Carousels"

Set fs = CreateObject("Scripting.FileSystemObject")

fs.CopyFile sSource, sDestination

End Sub
 
B

Barb Reinhardt

I use something like this

FileCopy CurrentPath, newPath

Where CurrentPath is the FULL PATH for the file and NewPath is the full path
for it's new location
 
D

Dave Peterson

Option Explicit
sub testme()

Dim myOldPath as string
Dim myNewPath as string
dim myRng as range
dim myCell as range

myoldpath = "C:\somepathhere\"
mynewpath = "C:\someotherpathhere\"

with worksheets("search results")
set myrng = .range("C1",.cells(.rows.count,"C").end(xlup))
end with

for each mycell in myrng.cells
filecopy source:=myoldpath & mycell.value & ".jpg", _
destination:=mynewpath & mycell.value & ".jpg
next mycell

end sub

Untested and uncompiled. Watch out for typos.

(I added the extension (& ".jpg"). You may not need it.)
 
P

Paul B

Dave, thanks for the help, have it working now

Dave Peterson said:
Option Explicit
sub testme()

Dim myOldPath as string
Dim myNewPath as string
dim myRng as range
dim myCell as range

myoldpath = "C:\somepathhere\"
mynewpath = "C:\someotherpathhere\"

with worksheets("search results")
set myrng = .range("C1",.cells(.rows.count,"C").end(xlup))
end with

for each mycell in myrng.cells
filecopy source:=myoldpath & mycell.value & ".jpg", _
destination:=mynewpath & mycell.value & ".jpg
next mycell

end sub

Untested and uncompiled. Watch out for typos.

(I added the extension (& ".jpg"). You may not need it.)
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top