VBA Code To Copy Files From Path To Path

[hrayani]

Hello Friends,

I need a VBA code to copy all files from a folder located at From Path to a folder located at To Path but only those files which are new or have a modification date other than the files which already exists in To Path.

For example

CASE # 1
There are 25 files in the folder located at From Path out of which lets say 16 files already exists in the folder located at To Path.
In said case I would want the code to copy only 9 new files.

CASE # 2
There are 25 files in the folder located at From Path out of which lets say 16 files already exists in the folder located at To Path - but 2 files out of these 16 files have a modification date other than the files in the folder located at From Path.
In said case I would want the code to copy 11 files in total. 9 new files & 2 modified files.


From Path: "\\192.168.0.100\itex share\DESIGN"
To Path: "C:\ITEX DATA\DESIGN"



Any help would be appreciated

Regards,

Humayun

 

[dmt32]

Hi,
have a look at Ron de Bruins site here:https://www.rondebruin.nl/win/s3/win026.htm

There is an example code named Copy_Files_Dates that may be close to what you want.

Dave

 

[hrayani]

Hi Dave,

Thanks for the reply. I went through the link and found the below code which is very close to what I want...

Here it is...

Sub Copy_Files_Dates()'This example copy all files between certain dates from FromPath to ToPath.
'You can also use this to copy the files from the last ? days
'If Fdate >= Date - 30 Then
'Note: If the files in ToPath already exist it will overwrite existing files in this folder
    Dim FSO As Object
    Dim FromPath As String
    Dim ToPath As String
    Dim Fdate As Date
    Dim FileInFromFolder As Object


    FromPath = "\\192.168.0.100\itex share\ITEX\DESIGNS"  '<< Change
    ToPath = "C:\ITEX DATA\DESIGNS"    '<< Change


    If Right(FromPath, 1) <> "\" Then
        FromPath = FromPath & "\"
    End If


    If Right(ToPath, 1) <> "\" Then
        ToPath = ToPath & "\"
    End If


    Set FSO = CreateObject("scripting.filesystemobject")


    If FSO.FolderExists(FromPath) = False Then
        MsgBox FromPath & " doesn't exist"
        Exit Sub
    End If


    If FSO.FolderExists(ToPath) = False Then
        MsgBox ToPath & " doesn't exist"
        Exit Sub
    End If


    For Each FileInFromFolder In FSO.getfolder(FromPath).Files
        Fdate = Int(FileInFromFolder.DateLastModified)
        
       If Fdate >= DateSerial(Range("L44").Value, Range("L45").Value, Range("L46").Value) And Fdate <= DateSerial(Range("N44").Value, Range("N45").Value, Range("N46").Value) Then


            FileInFromFolder.Copy ToPath
        End If
    Next FileInFromFolder
    
Sheets("INDEX").Unprotect Password:="merchant"
  
Sheets("INDEX").Range("L41").Value = Now


Sheets("INDEX").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="merchant"


End Sub

Now there are few points - I need help with...

1) There are at this point of time 3 folders located at From Path which needs to copied to 3 folders located at To Path. How to add them in the code...

2) The problem is that if someone puts a file into the From Path folder which does not match with the To & From date - then it will not be copied.
For Example
The code copies all files from 01-Nov-19 to 12-Nov-19
After that if someone puts a file in the From Path folder which has a date earlier than 01-Nov-19 then the code will overlook it. I know I can change the dates but by doing so the code will take too long to run as it will copy all the files and then overwrite it.

Isn't it possible for the code to not look at the dates - just copy all the files which are not there in the To Path folder also looking at the file dates.

a) copy all the files which are there in the From Path folder but are not in the To Path Folder
b) copy all the files which are there in the both the Folders but there dates don't match


Regards,

Humayun

 

[dmt32]

Hi Dave,

Thanks for the reply. I went through the link and found the below code which is very close to what I want...



Now there are few points - I need help with...

1) There are at this point of time 3 folders located at From Path which needs to copied to 3 folders located at To Path. How to add them in the code...

2) The problem is that if someone puts a file into the From Path folder which does not match with the To & From date - then it will not be copied.
For Example
The code copies all files from 01-Nov-19 to 12-Nov-19
After that if someone puts a file in the From Path folder which has a date earlier than 01-Nov-19 then the code will overlook it. I know I can change the dates but by doing so the code will take too long to run as it will copy all the files and then overwrite it.

Isn't it possible for the code to not look at the dates - just copy all the files which are not there in the To Path folder also looking at the file dates.

a) copy all the files which are there in the From Path folder but are not in the To Path Folder
b) copy all the files which are there in the both the Folders but there dates don't match


Regards,

Humayun

Hi,
suggest you update Ron's code to meet your specific need one part at a time

To address point one you can change the String variables FromPath & ToPath to string arrays & then loop through these in the code

Sub Copy_Files_Dates()
'Ron de Bruin code
'This example copy all files between certain dates from FromPath to ToPath.
'You can also use this to copy the files from the last ? days
'If Fdate >= Date - 30 Then
'Note: If the files in ToPath already exist it will overwrite existing files in this folder
    Dim FSO As Object
    Dim FromPath(1 To 3) As String, ToPath(1 To 3) As String
    Dim i As Integer
    Dim Fdate As Date
    Dim FileInFromFolder As Object


'enter paths to array elements as required
    FromPath(1) = "\\192.168.0.100\itex share\ITEX\DESIGNS"
    FromPath(2) = "\\192.168.0.100\itex share\ITEX\DESIGNS"
    FromPath(3) = "\\192.168.0.100\itex share\ITEX\DESIGNS"
    
    
    ToPath(1) = "C:\ITEX DATA\DESIGNS"
    ToPath(2) = "C:\ITEX DATA\DESIGNS"
    ToPath(3) = "C:\ITEX DATA\DESIGNS"








    Set FSO = CreateObject("scripting.filesystemobject")




    For i = 1 To 3
    If Right(FromPath(i), 1) <> "\" Then FromPath(i) = FromPath(i) & "\"
    If Right(ToPath(i), 1) <> "\" Then ToPath(i) = ToPath & "\"


        If FSO.FolderExists(FromPath(i)) = False Then MsgBox FromPath(i) & " doesn't exist": Exit Sub
        If FSO.FolderExists(ToPath(i)) = False Then MsgBox ToPath(i) & " doesn't exist": Exit Sub
        
        For Each FileInFromFolder In FSO.getfolder(FromPath(i)).Files
            Fdate = Int(FileInFromFolder.DateLastModified)
            
           If Fdate >= DateSerial(Range("L44").Value, Range("L45").Value, Range("L46").Value) And Fdate <= DateSerial(Range("N44").Value, Range("N45").Value, Range("N46").Value) Then
    
                FileInFromFolder.Copy ToPath(i)
           End if
        Next FileInFromFolder
        
    Next i
    
    With Sheets("INDEX")
        .Unprotect Password:="merchant"
        .Range("L41").Value = Now
        .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="merchant"
    End With




End Sub

Updated code untested

Dave

 

[hrayani]

Hi Dave,

Thanks for solving point # 1 for me.....

It was giving compile error on this line

[COLOR=#333333]If Right(ToPath(i), 1) <> "\" Then ToPath(i) = [/COLOR][B][COLOR=#ff0000]ToPath & [/COLOR][/B][COLOR=#333333]"\"[/COLOR]

I changed it to ToPath(i)

Working fine now.... point # 1 SOLVED

Please look into the second part

Regards,

Humayun

 

[hrayani]

Hello Friends,

I am using this code to copy all files from 3 folders located at From Path to 3 folders located at To Path but only those files which are new or have a modification date other than the files which already exists in To Path.

Sub Copy_Files_From_To()

    Dim FSO As Object
    Dim FromPath(1 To 3) As String, ToPath(1 To 3) As String
    Dim i As Integer
    Dim Fdate As Date
    Dim FileInFromFolder As Object

    FromPath(1) = "\\192.168.0.100\itex share\OneDrive\Documents\DESIGNS"
    FromPath(2) = "\\192.168.0.100\itex share\OneDrive\Documents\PO"
    FromPath(3) = "\\192.168.0.100\itex share\OneDrive\Documents\INTERNAL SHEET"

    ToPath(1) = "C:\ITEX DATA\DESIGNS"
    ToPath(2) = "C:\ITEX DATA\PO"
    ToPath(3) = "C:\ITEX DATA\INTERNAL SHEET"
   
    Set FSO = CreateObject("scripting.filesystemobject")
   
    For i = 1 To 3
    If Right(FromPath(i), 1) <> "\" Then FromPath(i) = FromPath(i) & "\"
    If Right(ToPath(i), 1) <> "\" Then ToPath(i) = ToPath(i) & "\"

        If FSO.FolderExists(FromPath(i)) = False Then MsgBox FromPath(i) & " doesn't exist": Exit Sub
        If FSO.FolderExists(ToPath(i)) = False Then MsgBox ToPath(i) & " doesn't exist": Exit Sub
       
        For Each FileInFromFolder In FSO.getfolder(FromPath(i)).Files
            Fdate = Int(FileInFromFolder.DateLastModified)

           If Fdate >= DateSerial(Range("L44").Value, Range("L45").Value, Range("L46").Value) And Fdate <= DateSerial(Range("N44").Value, Range("N45").Value, Range("N46").Value) Then
   
                FileInFromFolder.Copy ToPath(i)
           End If
        Next FileInFromFolder
       
    Next i
   
    With Sheets("INDEX")
        .Unprotect Password:="merchant"
        .Range("L41").Value = Now
        .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="merchant"
    End With
End Sub

Now the change I require is that the 3 From Path Folders are on one drive. So I want the code to look at the folder available on one drive

as of now the From Path Folder is this which works fine
FromPath(1) = "\\192.168.0.100\itex share\OneDrive\Documents\DESIGNS"

How to tell the code to look at this URL instead of the above location

https://onedrive.live.com/?authkey=%21AF%5FOcFoA0MokIzw&id=xxxxxxxxxxxxxxxxxxxxxxxxxx=xxxxxxxxxxxxxxxx

Any help would be appreciated

Regards,

Humayun

 

[hrayani]

Hi,

Still awaiting reply for my last post

Help Please