I am big into Ancestry and I am trying to copy files used on a particular branch of a tree to a separate folder as a gift to that family member (The gift also includes their tree ). I use a relational database for storage of the tree and its multimedia report can be saved as a excel wb. I have managed to extract that info into a .xlsm file where I am trying to get the macro Copy_MediaV2() to work.
Column A is the file name
and Column B is the Source Path and file name of the file I wish to copy.
E1 Contains the Destination Path (Would like this be be an open of explorer and select Destination Path)
Possible Errors
Source Folder does not exist
File does not exist in Source Path (advise in Column m & and by msg box)
File already exists in Destination Path (overwrite and advise in Column m and by msg box)
I have got myself into a complete dither in the past 24 hours. This morning I ran this again and somehow it has found a random image and converted it to a .dll and placed that in the destination as well as the other files.
The error messaging is out of sync with what is actually happening. The reporting in Column M is not as desired. As I said opening explorer to define the destination folder is also preferable. Thanks in advance and hopefully I have described the challenge as neatly as possible. Regards Wayne b
Multimedia List.xlsm | |||||||||||||||
---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
A | B | C | D | E | F | G | H | I | J | K | L | M | |||
1 | FileName | SourcePath and FileName | C:\Users\Big W\OneDrive\Documents\Julies Folder\ImageCopy\ | FileName | |||||||||||
2 | Arthur Ernest and Winifred Agnes Isaacson Gravesite.jpeg | C:\Users\Big W\OneDrive\Documents\MoveTest\Arthur Ernest and Winifred Agnes Isaacson Gravesite.jpeg | |||||||||||||
3 | Arthur Ernest and Winifred Agnes Isaacson Headstone.jpeg | C:\Users\Big W\OneDrive\Documents\MoveTest\Arthur Ernest and Winifred Agnes Isaacson Headstone.jpeg | |||||||||||||
4 | Mary Bennie Headstone and Robert Bennie Memorial.jpeg | C:\Users\Big W\OneDrive\Documents\MoveTest\Mary Bennie Headstone and Robert Bennie Memorial.jpeg | |||||||||||||
5 | Robert McCullough Bennie.jpg | C:\Users\Big W\OneDrive\Documents\MoveTest2\Robert McCullough Bennie.jpg | |||||||||||||
6 | a60ad9ad-8260-4cbe-928b-b6f1e04816e4.jpg | C:\Users\Big W\OneDrive\Documents\MoveTest\a60ad9ad-8260-4cbe-928b-b6f1e04816e4.jpg | |||||||||||||
7 | George Isaacson and Sarah ****erton Marriage record.jpg | C:\Users\Big W\OneDrive\Documents\MoveTest2\George Isaacson and Sarah ****erton Marriage record.jpg | |||||||||||||
8 | Charles Cuthbert Ryan WW1 Military Record NAA 1.pdf | C:\Users\Big W\OneDrive\Documents\MoveTest\Charles Cuthbert Ryan WW1 Military Record NAA 1.pdf | |||||||||||||
Working |
Column A is the file name
and Column B is the Source Path and file name of the file I wish to copy.
E1 Contains the Destination Path (Would like this be be an open of explorer and select Destination Path)
Possible Errors
Source Folder does not exist
File does not exist in Source Path (advise in Column m & and by msg box)
File already exists in Destination Path (overwrite and advise in Column m and by msg box)
I have got myself into a complete dither in the past 24 hours. This morning I ran this again and somehow it has found a random image and converted it to a .dll and placed that in the destination as well as the other files.
The error messaging is out of sync with what is actually happening. The reporting in Column M is not as desired. As I said opening explorer to define the destination folder is also preferable. Thanks in advance and hopefully I have described the challenge as neatly as possible. Regards Wayne b
VBA Code:
Sub Copy_MediaV2()
Dim r As Long
Dim SourcePath As String
Dim dstPath As String
Dim myFile As String
Dim noFile As String
Dim cFile As String
'SourcePath = Range("d1")
dstPath = Range("e1")
'Column M Report
noFolder = "No Source Folder Found"
noFile = "No File found in Source Folder"
fExists = "File already existed in destination and was overwritten"
'cFile = "File Copied to destination Folder"
'On Error GoTo ErrHandler
For r = 1 To 3000
myFile = Range("A" & r)
'FileCopy SourcePath & myFile, dstPath & myFile
myFile = Dir(dstPath & Range("A" & r))
SourcePath = Dir(Range("b" & r)) 'added direct source path from Column b
FileCopy SourcePath, myFile
'FileCopy SourcePath & myFile, dstPath & myFile
If Range("A" & r) = "" Then
On Error GoTo ErrHandler
Exit For
End If
'MsgBox "The file(s) can be found in: " & vbNewLine & dstPath, , "COPY COMPLETED"
Range("A" & r).Copy Range("M" & r)
Next r
MsgBox "The file(s) can be found in: " & vbNewLine & dstPath, , "COPY COMPLETED"
Exit Sub
ErrHandler:
MsgBox "Copy error: " & SourcePath & myFile & vbNewLine & vbNewLine & _
"File could not be found in the source folder", , "MISSING FILE(S)"
Range("A" & r).Copy Range("M" & r)
' Range("m" & r) = noFile
Resume Next
End Sub