locked
Copy Files from one directory to another through vba RRS feed

  • Question

  • Hi,

    Every day I receive several files from different sources and from those files I need to identify only some. As the count of those files are increasing, it's almost impossible to handle it manually. I wanted to have a macro that will accomplish such activity.

    I have one excel file with 3 columns. 

    1. Folder -- It contains the address of all the files which I used to receive everyday. Folder name should be displayed in A2 cell. 

    2. File names- All the file names which are present in the above mentioned folder should be displayed in B row starting from B2(I have separate macro for that).

    3. Select- This column will be the C column of excel and here I'll provide my input as Yes/No.(Only Yes/No- Other value should not be accepted) starting from C2. If the answer is yes the corresponding file from B column will be copied from the folder mentioned in A2 cell and paste it to C drive.(C:\Work). If the answer is no then those files won't be copied from the folder mentioned in A2 cell. 

    This copy and Paste function to be triggered by a command Button.

    As the count of files will be more I want to have another validation like:

    If B column is populating with a file name then C column has to be populated with Yes/No - Otherwise system should throw an error.

    I have uploaded one sample excel for your reference.

    https://onedrive.live.com/redir?resid=93C93EA15AA6C592!108&authkey=!ADQwc4p-E4a_wfg&ithint=file%2cxlsx

    Thank You.


    • Edited by JO_LO Friday, May 15, 2015 5:13 PM
    Friday, May 15, 2015 5:09 PM

Answers

  • Option Explicit
    Option Compare Text
    
    Private Sub CommandButton1_Click()
      Dim SourcePath As String, DestPath As String, FName As String
      Dim R As Range
      
      'Setup pathes
      SourcePath = Range("A2")
      DestPath = "C:\Work\"
      
      'Be sure they are valid for our needs
      If Right(SourcePath, 1) <> "\" Then SourcePath = SourcePath & "\"
      If Right(DestPath, 1) <> "\" Then DestPath = DestPath & "\"
      If Dir(SourcePath, vbDirectory) = "" Then
        MsgBox SourcePath & " doesn't exists"
        Exit Sub
      End If
      If Dir(DestPath, vbDirectory) = "" Then
        MsgBox DestPath & " doesn't exists"
        Exit Sub
      End If
      
      'Find last used cell in column C
      Set R = Range("C" & Rows.Count).End(xlUp)
      If R.Row < 2 Then Exit Sub
      'In each used cell
      For Each R In Range("C2", R)
        If R = "Yes" Then
          'Get the file name
          FName = R.Offset(, -1)
          'If file exists...
          If Dir(SourcePath & FName) <> "" Then
            '... copy
            FileCopy SourcePath & FName, DestPath & FName
          End If
        ElseIf R = "No" Then
          'Ignore
        ElseIf Not IsEmpty(R.Offset(, -1)) Then
          'If B column is populating with a file name then C column has to be populated with Yes/No
          R.EntireRow.Select
          MsgBox "Otherwise system should throw an error."
          Exit Sub
        End If
      Next
    End Sub
    

    • Marked as answer by JO_LO Wednesday, May 20, 2015 5:54 PM
    Saturday, May 16, 2015 2:21 PM
  • I have run the full code with the changes you have mentioned but it I'm getting Range of Worksheet Failed error in the below mentioned line:

    I think I need some holidays, so many mistakes I make normally never. :-)

    Andreas.

    Option Explicit
    Option Compare Text
    
    Private Sub CommandButton1_Click()
      Dim SourcePath As String, DestPath As String, FName As String
      Dim R As Range
      
      'Setup pathes
      SourcePath = Range("A2")
      DestPath = "C:\Work\"
      
      'Be sure they are valid for our needs
      If Right(SourcePath, 1) <> "\" Then SourcePath = SourcePath & "\"
      If Right(DestPath, 1) <> "\" Then DestPath = DestPath & "\"
      If Dir(SourcePath, vbDirectory) = "" Then
        MsgBox SourcePath & " doesn't exists"
        Exit Sub
      End If
      If Dir(DestPath, vbDirectory) = "" Then
        MsgBox DestPath & " doesn't exists"
        Exit Sub
      End If
      
      'Find last used cell in column C
      Set R = Range("C" & Rows.Count).End(xlUp)
      If R.Row < 2 Then Exit Sub
      For Each R In Range("C2", R)
        Select Case R
          Case "Yes", "No"
          Case Else
            'Check if cell in column B is empty, enable if necessary
            'If Not IsEmpty(R.Offset(, -1)) Then
              R.EntireRow.Select
              MsgBox "Please enter Yes/No in all the cells of C Column."
              Exit Sub
            'End If
        End Select
      Next
      
      'In each used cell
      Set R = Range("C" & Rows.Count).End(xlUp)
      For Each R In Range("C2", R)
        If R = "Yes" Then
          'Get the file name
          FName = R.Offset(, -1)
          'If file exists...
          If Dir(SourcePath & FName) <> "" Then
            '... copy
            FileCopy SourcePath & FName, DestPath & FName
          End If
        ElseIf R = "No" Then
          'Ignore
        ElseIf Not IsEmpty(R.Offset(, -1)) Then
          'If B column is populating with a file name then C column has to be populated with Yes/No
          R.EntireRow.Select
          MsgBox "System only allow Yes/No in C Column."
          Exit Sub
        End If
      Next
    End Sub


    • Marked as answer by JO_LO Wednesday, May 20, 2015 5:54 PM
    Tuesday, May 19, 2015 7:11 AM
  • It would be better if I have this validation in this code so that code will only start copying when all the cells in C column have either Yes/No.

    Alright, that's not a big deal, we can take column B as a starting point instead of Column C.

    Andreas.

    Option Explicit
    Option Compare Text
    
    Private Sub CommandButton1_Click()
      Dim SourcePath As String, DestPath As String, FName As String
      Dim R As Range, All As Range
    
      'Setup pathes
      SourcePath = Range("A2")
      DestPath = "C:\Work\"
    
      'Be sure they are valid for our needs
      If Right(SourcePath, 1) <> "\" Then SourcePath = SourcePath & "\"
      If Right(DestPath, 1) <> "\" Then DestPath = DestPath & "\"
      If Dir(SourcePath, vbDirectory) = "" Then
        MsgBox SourcePath & " doesn't exists"
        Exit Sub
      End If
      If Dir(DestPath, vbDirectory) = "" Then
        MsgBox DestPath & " doesn't exists"
        Exit Sub
      End If
    
      'Find last used cell in column B
      Set R = Range("B" & Rows.Count).End(xlUp)
      If R.Row < 2 Then Exit Sub
      Set All = Range("B2", R)
      
      For Each R In All
        If Not IsEmpty(R) Then
          Select Case R.Offset(, 1)
            Case "Yes", "No"
            Case Else
              R.EntireRow.Select
              MsgBox "Please enter Yes/No in all the cells of C Column."
              Exit Sub
          End Select
        End If
      Next
    
      For Each R In All
        If R.Offset(, 1) = "Yes" Then
          'Get the file name
          FName = R
          'If file exists...
          If Dir(SourcePath & FName) <> "" Then
            '... copy
            FileCopy SourcePath & FName, DestPath & FName
          End If
        End If
      Next
    End Sub
    

    • Marked as answer by JO_LO Wednesday, May 20, 2015 5:53 PM
    Tuesday, May 19, 2015 5:39 PM

All replies

  • Option Explicit
    Option Compare Text
    
    Private Sub CommandButton1_Click()
      Dim SourcePath As String, DestPath As String, FName As String
      Dim R As Range
      
      'Setup pathes
      SourcePath = Range("A2")
      DestPath = "C:\Work\"
      
      'Be sure they are valid for our needs
      If Right(SourcePath, 1) <> "\" Then SourcePath = SourcePath & "\"
      If Right(DestPath, 1) <> "\" Then DestPath = DestPath & "\"
      If Dir(SourcePath, vbDirectory) = "" Then
        MsgBox SourcePath & " doesn't exists"
        Exit Sub
      End If
      If Dir(DestPath, vbDirectory) = "" Then
        MsgBox DestPath & " doesn't exists"
        Exit Sub
      End If
      
      'Find last used cell in column C
      Set R = Range("C" & Rows.Count).End(xlUp)
      If R.Row < 2 Then Exit Sub
      'In each used cell
      For Each R In Range("C2", R)
        If R = "Yes" Then
          'Get the file name
          FName = R.Offset(, -1)
          'If file exists...
          If Dir(SourcePath & FName) <> "" Then
            '... copy
            FileCopy SourcePath & FName, DestPath & FName
          End If
        ElseIf R = "No" Then
          'Ignore
        ElseIf Not IsEmpty(R.Offset(, -1)) Then
          'If B column is populating with a file name then C column has to be populated with Yes/No
          R.EntireRow.Select
          MsgBox "Otherwise system should throw an error."
          Exit Sub
        End If
      Next
    End Sub
    

    • Marked as answer by JO_LO Wednesday, May 20, 2015 5:54 PM
    Saturday, May 16, 2015 2:21 PM
  • Wow!! It works like a charm!! 

    Just a bit more help needed. As I am dealing with a very large number of files it would be better if system could notify me on which file name I have missed to put Yes/No.

    For example:

    If I have 300 File names in B column(Starting from B2) it is mandatory to have a Yes/No statement in C Column against each file name.

    Suppose I missed to put Yes/No against 10 files, system should notify me the file names against which I have to provide Yes/No.

    Please let me know if I need to explain a bit more.

    Thank You. 

    Saturday, May 16, 2015 7:06 PM
  • If I have 300 File names in B column(Starting from B2) it is mandatory to have a Yes/No statement in C Column against each file name.

    Suppose I missed to put Yes/No against 10 files, system should notify me the file names against which I have to provide Yes/No.


    IMHO for such a large number of files it would not help you to know the file name, because you have to search it in the list afterwards when the message form the macro is gone.

    A better way is to use a helper column:

    D1:  =COUNTIF(D2:D1000,"Missing")
    D2:  =IF(B2<>"",IF(NOT(OR(C2="Yes",C2="No")),"Missing",""),"")

    Drag the formula in D2 down to the end of the data.

    With just a look into D1 you can see if you miss something and when you filter the data for "Missing" in column D, you have all missing files at one glance.

    Andreas.

    Sunday, May 17, 2015 10:57 AM
  • Hi Andreas,

    Thanks for your suggestion. The sheet in which I have the file names is creating from another macro. So instead of manually enter the formula in D column, is it possible to insert the formula in the code that you have posted above. 

    >>IMHO for such a large number of files it would not help you to know the file name, because you have to search it in the list afterwards when the message form the macro is gone.<<

    I understand your point and instead of returning the name of the file if the code displays 'Missing' keyword in 'D' column that would also be helpful. I just want to use this formula which you have shown above in the code itself.

    Also, I have noticed one thing if B column has a fille name and C column is not populated with Yes/No then also the code is copying the files against which C column has 'Yes' value. It always better to have a check at this position. The code should not start copying files until and unless C Column has  a value Yes/No against all the files present in B column. 

    Thank You. 



    • Edited by JO_LO Sunday, May 17, 2015 11:48 AM
    Sunday, May 17, 2015 11:28 AM
  • Hi JO_LO,

    Base on Andreas’s code, he already deals with that scenario.

      ElseIf Not IsEmpty(R.Offset(, -1)) Then
          'If B column is populating with a file name then C column has to be populated with Yes/No
          R.EntireRow.Select
          MsgBox "Otherwise system should throw an error."
          Exit Sub
        End If
    

    If you want to display column B’s value, you could use this code below:

    MsgBox R.Offset(, -1)

    Regards

    Starain


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.

    Monday, May 18, 2015 7:04 AM
  • Hi,

    I have checked it and found if C Column is Null against a file name, then also Files for which C Column has Yes are copying in Destination folder. I want a validation like until and unless all the cells in C Column are populated with Yes/No, code won’t start copying. 

    Thanks You.

    Monday, May 18, 2015 9:27 AM
  • Add this loop before the other FOR loop in the macro above.

      For Each R In Range("C2", R)
        Select Case R
          Case "Yes", "No"
            R.EntireRow.Select
            MsgBox "Otherwise system should throw an error."
            Exit Sub
        End Select
      Next
    

    Monday, May 18, 2015 10:17 AM
  • Hi Andreas,

    I have added the code you have mentioned. But I’m getting the reverse result. If C Column has Yes/No system is showing Otherwise system should throw an error.

    And If C Column is Null it is not showing any error message. Please let me know if I missed anything.

    Option Explicit
    Option Compare Text
    Private Sub CommandButton21_Click()
    
    
    
      Dim SourcePath As String, DestPath As String, FName As String
      Dim R As Range
      
      'Setup pathes
      SourcePath = Range("A2")
      DestPath = "C:\Work\"
      
      'Be sure they are valid for our needs
      If Right(SourcePath, 1) <> "\" Then SourcePath = SourcePath & "\"
      If Right(DestPath, 1) <> "\" Then DestPath = DestPath & "\"
      If Dir(SourcePath, vbDirectory) = "" Then
        MsgBox SourcePath & " doesn't exists"
        Exit Sub
      End If
      If Dir(DestPath, vbDirectory) = "" Then
        MsgBox DestPath & " doesn't exists"
        Exit Sub
      End If
      
      'Find last used cell in column C
      Set R = Range("C" & Rows.Count).End(xlUp)
      If R.Row < 2 Then Exit Sub
      For Each R In Range("C2", R)
        Select Case R
          Case "Yes", "No"
            R.EntireRow.Select
            MsgBox "Otherwise system should throw an error."
            Exit Sub
        End Select
      Next
      'In each used cell
      For Each R In Range("C2", R)
        If R = "Yes" Then
          'Get the file name
          FName = R.Offset(, -1)
          'If file exists...
          If Dir(SourcePath & FName) <> "" Then
            '... copy
            FileCopy SourcePath & FName, DestPath & FName
          End If
        ElseIf R = "No" Then
          'Ignore
        ElseIf Not IsEmpty(R.Offset(, -1)) Then
          'If B column is populating with a file name then C column has to be populated with Yes/No
          R.EntireRow.Select
          MsgBox "Otherwise system should throw an error."
          Exit Sub
        End If
      Next
    End Sub
    

    Monday, May 18, 2015 10:32 AM
  • But I’m getting the reverse result.

    Uups, my fault, sorry, "Case Else" line is missing, change the code to this:

    For Each R In Range("C2", R)
        Select Case R
          Case "Yes", "No"
          Case Else
            R.EntireRow.Select
            MsgBox "Otherwise system should throw an error."
            Exit Sub
        End Select
      Next

    Monday, May 18, 2015 3:01 PM
  • It's ok Andreas. You don't need to be sorry!! ;) I really appreciate for your time and help.

    I have run the full code with the changes you have mentioned but it I'm getting Range of Worksheet Failed error in the below mentioned line:

    For Each R In Range("C2", R)

    PFB the code that I'm using.

    Option Explicit
    Option Compare Text
    Private Sub CommandButton1_Click()
     Dim SourcePath As String, DestPath As String, FName As String
      Dim R As Range
     
      
      'Setup pathes
      SourcePath = Range("A2")
      DestPath = "C:\Work\"
      
      
      'Be sure they are valid for our needs
      If Right(SourcePath, 1) <> "\" Then SourcePath = SourcePath & "\"
      If Right(DestPath, 1) <> "\" Then DestPath = DestPath & "\"
      If Dir(SourcePath, vbDirectory) = "" Then
        MsgBox SourcePath & " doesn't exists"
        Exit Sub
      End If
      If Dir(DestPath, vbDirectory) = "" Then
        MsgBox DestPath & " doesn't exists"
        Exit Sub
      End If
      
      'Find last used cell in column C
      Set R = Range("C" & Rows.Count).End(xlUp)
      If R.Row < 2 Then Exit Sub
      For Each R In Range("C2", R)
        Select Case R
          Case "Yes", "No"
          Case Else
            R.EntireRow.Select
            MsgBox "Please enter Yes/No in all the cells of C Column."
            Exit Sub
        End Select
      Next
      'In each used cell
      For Each R In Range("C2", R)
        If R = "Yes" Then
          'Get the file name
          FName = R.Offset(, -1)
          'If file exists...
          If Dir(SourcePath & FName) <> "" Then
            '... copy
            FileCopy SourcePath & FName, DestPath & FName
          End If
        ElseIf R = "No" Then
          'Ignore
        ElseIf Not IsEmpty(R.Offset(, -1)) Then
          'If B column is populating with a file name then C column has to be populated with Yes/No
          R.EntireRow.Select
          MsgBox "System only allow Yes/No in C Column."
          Exit Sub
        End If
        
      Next
    End Sub

    Thank You.


    • Edited by JO_LO Monday, May 18, 2015 6:14 PM
    Monday, May 18, 2015 6:14 PM
  • I have run the full code with the changes you have mentioned but it I'm getting Range of Worksheet Failed error in the below mentioned line:

    I think I need some holidays, so many mistakes I make normally never. :-)

    Andreas.

    Option Explicit
    Option Compare Text
    
    Private Sub CommandButton1_Click()
      Dim SourcePath As String, DestPath As String, FName As String
      Dim R As Range
      
      'Setup pathes
      SourcePath = Range("A2")
      DestPath = "C:\Work\"
      
      'Be sure they are valid for our needs
      If Right(SourcePath, 1) <> "\" Then SourcePath = SourcePath & "\"
      If Right(DestPath, 1) <> "\" Then DestPath = DestPath & "\"
      If Dir(SourcePath, vbDirectory) = "" Then
        MsgBox SourcePath & " doesn't exists"
        Exit Sub
      End If
      If Dir(DestPath, vbDirectory) = "" Then
        MsgBox DestPath & " doesn't exists"
        Exit Sub
      End If
      
      'Find last used cell in column C
      Set R = Range("C" & Rows.Count).End(xlUp)
      If R.Row < 2 Then Exit Sub
      For Each R In Range("C2", R)
        Select Case R
          Case "Yes", "No"
          Case Else
            'Check if cell in column B is empty, enable if necessary
            'If Not IsEmpty(R.Offset(, -1)) Then
              R.EntireRow.Select
              MsgBox "Please enter Yes/No in all the cells of C Column."
              Exit Sub
            'End If
        End Select
      Next
      
      'In each used cell
      Set R = Range("C" & Rows.Count).End(xlUp)
      For Each R In Range("C2", R)
        If R = "Yes" Then
          'Get the file name
          FName = R.Offset(, -1)
          'If file exists...
          If Dir(SourcePath & FName) <> "" Then
            '... copy
            FileCopy SourcePath & FName, DestPath & FName
          End If
        ElseIf R = "No" Then
          'Ignore
        ElseIf Not IsEmpty(R.Offset(, -1)) Then
          'If B column is populating with a file name then C column has to be populated with Yes/No
          R.EntireRow.Select
          MsgBox "System only allow Yes/No in C Column."
          Exit Sub
        End If
      Next
    End Sub


    • Marked as answer by JO_LO Wednesday, May 20, 2015 5:54 PM
    Tuesday, May 19, 2015 7:11 AM
  • Hi Andreas,

    Sorry to disappoint you one more time. Everything  is going fine but suddenly I have noticed one thing, the last row contains a File Name in B Column but corresponding C Column is blank,  then also Files for which C Column has Yes are copying in Destination folder. It would be better if I have this validation in this code so that code will only start copying when all the cells in C column have either Yes/No.

    I have uploaded my sheet into one drive for your reference.

    https://onedrive.live.com/redir?resid=93C93EA15AA6C592!109&authkey=!AM6-ESuxovPX6VQ&ithint=file%2cxlsm

    Tuesday, May 19, 2015 3:31 PM
  • It would be better if I have this validation in this code so that code will only start copying when all the cells in C column have either Yes/No.

    Alright, that's not a big deal, we can take column B as a starting point instead of Column C.

    Andreas.

    Option Explicit
    Option Compare Text
    
    Private Sub CommandButton1_Click()
      Dim SourcePath As String, DestPath As String, FName As String
      Dim R As Range, All As Range
    
      'Setup pathes
      SourcePath = Range("A2")
      DestPath = "C:\Work\"
    
      'Be sure they are valid for our needs
      If Right(SourcePath, 1) <> "\" Then SourcePath = SourcePath & "\"
      If Right(DestPath, 1) <> "\" Then DestPath = DestPath & "\"
      If Dir(SourcePath, vbDirectory) = "" Then
        MsgBox SourcePath & " doesn't exists"
        Exit Sub
      End If
      If Dir(DestPath, vbDirectory) = "" Then
        MsgBox DestPath & " doesn't exists"
        Exit Sub
      End If
    
      'Find last used cell in column B
      Set R = Range("B" & Rows.Count).End(xlUp)
      If R.Row < 2 Then Exit Sub
      Set All = Range("B2", R)
      
      For Each R In All
        If Not IsEmpty(R) Then
          Select Case R.Offset(, 1)
            Case "Yes", "No"
            Case Else
              R.EntireRow.Select
              MsgBox "Please enter Yes/No in all the cells of C Column."
              Exit Sub
          End Select
        End If
      Next
    
      For Each R In All
        If R.Offset(, 1) = "Yes" Then
          'Get the file name
          FName = R
          'If file exists...
          If Dir(SourcePath & FName) <> "" Then
            '... copy
            FileCopy SourcePath & FName, DestPath & FName
          End If
        End If
      Next
    End Sub
    

    • Marked as answer by JO_LO Wednesday, May 20, 2015 5:53 PM
    Tuesday, May 19, 2015 5:39 PM