Copy files from one folder to another using list and error handling with message box

[Samadhan Gaikwad]

I have macro that copy files from one to another folder specified in cells. I want to enhance that code further
1) To check if user has added correct existing source path
2) To check if destination folder exists, if not create new one with given name
3) And run script only when file names are listed, source and destination path is there and when all is OK, then display Copy Completed which is there in code.

Sub Check()
If WorksheetFunction.CountA(Range("C2:C100000")) = 0 Then
        MsgBox "Please list file names in C column!"
  End If
If WorksheetFunction.CountA(Range("B2")) = 0 Then
        MsgBox "Please add source folder path!"
  End If
If WorksheetFunction.CountA(Range("B3")) = 0 Then
        MsgBox "Please add destination folder path!"
  End If
 
  CopyFiles
 
End Sub

Sub CopyFiles()

'Code: http://stackoverflow.com/questions/35726602/excel-vba-macro-copy-multiple-files-from-folder-to-folder
Dim r As Long
    Dim SourcePath As String
    Dim dstPath As String
    Dim myFile As String
    SourcePath = Range("B2")
    dstPath = Range("B3")

    On Error GoTo ErrHandler

    For r = 2 To 3000
        myFile = Dir(SourcePath & "\" & Range("C" & r))
        FileCopy SourcePath & "\" & myFile, dstPath & "\" & myFile

        If Range("C" & r) = "" Then
          Exit For
        End If

    Next r

        MsgBox "The file(s) can 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("C" & r).Copy Range("M" & r)

Resume Next

End Sub

 

[PCosta87]

Hi,

Just a question/suggestion, instead of asking the user to input the path manually, would it be OK to have a window popup to prompt him to select the source and destination folders?
That way the user wouldn't be allowed to input an invalid path and you would no longer need to account for that.

 

[Samadhan Gaikwad]

Ok, that will be fine!

 

[PCosta87]

Ok, that will be fine!

Here you go...
Sorry for the delay, couldn't get to it right away

Pressing the button will prompt the user to select the folder... pay attention to the top left corner of the windows as they will let you know which folder you are picking:

First:


Second:


Hope this helps.
Feel free to ask if you have any further questions.

 

[Samadhan Gaikwad]

Thank you so much, it's working nice!!!

 

[PCosta87]

Thank you so much, it's working nice!!!

Don't mention it

 

[Samadhan Gaikwad]

Similar question, I want to select and add dir. path to Sheets("Download_PRdata1").Range("A28") and also go ahead downloading files.
Right now it is downloading files to folder which is parent of selected folder.

Option Explicit

Private Declare Function URLDownloadToFile Lib "urlmon" _
Alias "URLDownloadToFileA" (ByVal pCaller As Long, _
ByVal szURL As String, ByVal szFileName As String, _
ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long

Dim ret As Long

Sub Download_new()

    On Error Resume Next
    Dim ws As Worksheet
    Dim LastRow As Long, i As Long
    Dim strPath, FolderName, ParentFolderName As String
  ' ParentFolderName = Sheets("Download_PRdata1").Range("A28") & "\"
 
    Sheets("Download_PRdata1").Range("A28").Value = ParentFolderName '& "\"
    Set ws = Sheets("Download_PRdata2")

    LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row
   
    For i = 1 To LastRow
         
        FolderName = ParentFolderName & ws.Range("A" & i).Value & "\"
        If Dir(FolderName) = "" Then
            MkDir FolderName
        End If
       
        strPath = FolderName & ws.Range("C" & i).Value '& ".zip"
        ret = URLDownloadToFile(0, ws.Range("E" & i).Value, strPath, 0, 0)

        If ret = 0 Then
            ws.Range("F" & i).Value = "File successfully downloaded"
        Else
            ws.Range("F" & i).Value = "Unable to download the file"
        End If
       
Next

End Sub

Function GetFolder() As String
    Dim fldr As FileDialog
    Dim ParentFolderName As String
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder to download PRdata into"
        .AllowMultiSelect = False
        .InitialFileName = Application.DefaultFilePath
        If .Show <> -1 Then GoTo NextCode
        ParentFolderName = .SelectedItems(1)
    End With
NextCode:
    GetFolder = ParentFolderName
    Set fldr = Nothing
    Download_new
End Function

 

[PCosta87]

Hi,

Similar question, I want to select and add dir. path to Sheets("Download_PRdata1").Range("A28") and also go ahead downloading files.
Right now it is downloading files to folder which is parent of selected folder.

This should probably be discussed on the other thread since it pertains to downloading files and not copying files from folder.

In any case, if I understood correctly, the "GetFolder" function below will return the path of the folder selected by the user. In the dialogbox you have the option to either select an existing folder or create a new one:

Function GetFolder(strPath As String) As String

    Dim fldr As FileDialog
    Dim sItem As String
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select Folder"
        .AllowMultiSelect = False
        .InitialFileName = strPath
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With
NextCode:
    GetFolder = sItem
    Set fldr = Nothing

End Function

Use the following in conjunction with the GetFolder function to return the path string to "A28" of the "Download_PRdata1" sheet:

    Sheets("Download_PRdata1").Range("A28").Value = GetFolder("C:\")

Hope this helps.

 

[Samadhan Gaikwad]

Thank you, I could manage code to make things work.

 

[PCosta87]

Thank you, I could manage code to make things work.

You are welcome
Let me know if there is something else I can help with.

 

[praveentheone]

Hi,
I would like to bring to your notice i am receiving an error msg as files missing even though the files exists at the source. I am trying to move certain no of files (say 100) from a source folder to multiple folders and its sub folders. i was using a variant of the code used here,it was giving me the missing error hence i used the copyfiles.xlsm shared here still it gives me same error and copy fails. Is there any other methods that works?

Sample workbook attached for reference.
Col. A is the file names for copying
Col. B is the folder names for transfer
Col. C source path
Col. D destination path

Here is the code i use.-

Sub File_Copy()
Dim r As Long
Dim SourcePath As String
Dim dstPath As String
Dim myFile As String
On Error GoTo ErrHandler
For r = 2 To Range("A" & Rows.Count).End(xlUp).Row
SourcePath = Range("C" & r)
dstPath = Range("D" & r)
myFile = Range("A" & r)
FileCopy SourcePath & "\" & myFile, dstPath & "\" & myFile
If Range("A" & r) = "" Then
Exit For
End If
Next r
MsgBox "The file(s) can found in: " & vbNewLine & dstPath, , "COPY COMPLETED"
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("F" & r)
Resume Next
End Sub

 

[praveentheone]

please help to solve this.

 

[Samadhan Gaikwad]

Just add formula

=CONCATENATE("copy ",C2,"\",A2," ",D2)

into cell "E2" and autofill it down. Open cmd from Start and copy paste all formulae in cmd. You're done.
Running these formulae from "E" column into cmd can be automated using vba, if needed.