Copy files from one folder to another folder based on inputs from a table

[kentnood]

Hi all,

May I have your help to add below functions to the vba please?


1. if source or destination folder do not exist, column D will remark" no source / destination file found".
2. For other situations, when a file was copied successfully, the corresponding cell in column D will automatically remark " transferred", however, when copy failed, the corresponding cell in column D will automatically remark "failed"
3. Where should I put on error resume next if I want the program to run through the last row?

tab1.JPG



****************************************

Dim fso
Dim source_file As String
Dim source_folder As String
Dim destination_folder As String
Dim lastrow As Integer

lastrow = ActiveSheet.UsedRange.Rows.Count

For i = 2 To lastrow
source_file = Cells(i, "a")
source_folder = Cells(i, "b")
destination_folder = Cells(i, "c")

Set fso = CreateObject("scripting.filesystemobject")
fso.CopyFile (source_folder & source_file), destination_folder, True
Cells(i, "d") = "successfully transferred"

Next i

End Sub
*******************************************

[Sintek]

....Wrong Thread....

[beyond Excel]

....Wrong Thread....

Why Syntec? It's repeated?...

[Sintek]

Why Syntec? It's repeated?...

No...I posted solution for other thread in this one...Hence deletion...

[Marc L]

1. if source or destination folder do not exist, column D will remark" no source / destination file found".

Hi,

why not better creating the destination folder if it does not exist ?
Easy with the Windows function MakeSureDirectoryPathExists as you can see in threads within this forum ...

[beyond Excel]

Hello
One way to do it:

Sub Macro32()
Dim C As Range, Tmp
For Each C In Range("A2", Range("A1").End(xlDown))
  C(, 4).ClearContents
  Select Case True
    Case Dir(C(, 2), vbDirectory) = ""
      C(, 4) = "Nonexistent Source path"
    Case Dir(C(, 3), vbDirectory) = ""
      C(, 4) = "Nonexistent Destination path"
    Case Dir(C(, 2) & C) = ""
      C(, 4) = "Nonexistent File"
    Case Else
      FileCopy C(, 2) & C, C(, 3) & C
      C(, 4) = "Successfully transferred"
  End Select
Next
End Sub

And comment if you change your mind and a new folder needs to be created.

[kentnood]

Hello
One way to do it:

Sub Macro32()
Dim C As Range, Tmp
For Each C In Range("A2", Range("A1").End(xlDown))
  C(, 4).ClearContents
  Select Case True
    Case Dir(C(, 2), vbDirectory) = ""
      C(, 4) = "Nonexistent Source path"
    Case Dir(C(, 3), vbDirectory) = ""
      C(, 4) = "Nonexistent Destination path"
    Case Dir(C(, 2) & C) = ""
      C(, 4) = "Nonexistent File"
    Case Else
      FileCopy C(, 2) & C, C(, 3) & C
      C(, 4) = "Successfully transferred"
  End Select
Next
End Sub

And comment if you change your mind and a new folder needs to be created.

Thank you very much, beyond Excel!

This is what I wanted. And yes, I want to create the new destination folders too. Could you advise again, please?

[beyond Excel]

Thank you very much, beyond Excel!

This is what I wanted. And yes, I want to create the new destination folders too. Could you advise again, please?

In the attached variant, if the destination path does not exist, the folder is created first, and then the file is copied:

Sub Macro34()
Dim C As Range, Tmp, mPath, iP
For Each C In Range("A2", Range("A1").End(xlDown))
  If Right(C(, 2), 1) <> "\" Then C(, 2) = C(, 2) & "\"
  If Right(C(, 3), 1) <> "\" Then C(, 3) = C(, 3) & "\"
  C(, 4).ClearContents
  Select Case True
    Case Dir(C(, 2), vbDirectory) = ""
      C(, 4) = "Nonexistent Source path"
    Case Dir(C(, 2) & C) = ""
      C(, 4) = "Nonexistent File"
    Case Dir(C(, 3), vbDirectory) = ""
      Tmp = Split(C(, 3), "\"): mPath = ""
      For Each iP In Tmp
        If iP = "" Then Exit For
        mPath = mPath & iP & "\"
        If Dir(mPath, vbDirectory) = "" Then MkDir mPath
      Next
      FileCopy C(, 2) & C, C(, 3) & C
      C(, 4) = "Successfully transferred"
    Case Else
      FileCopy C(, 2) & C, C(, 3) & C
      C(, 4) = "Successfully transferred"
  End Select
Next
End Sub

[Marc L]

See post #3 ...

[kentnood]

Thank you all for your input!