Archiving data files

xiaozhiz

New Member
Joined
Jun 12, 2021
Messages
2
Office Version
  1. 365
Platform
  1. Windows
Hi VBA experts,

I need some help on a data archiving project.
Basically I am trying to move data that are 2 days old out from original folder into a backup folder and a network drive. The 2 day time window is needed so that when the macro auto runs by task scheduler, it will not affect any folders/files that are currently being created/written/read only.
Below is what i have come up with. Thus I need some help to input the code for the 2 days old folder check.

here is my chain of events
Data created (multiple folders with multiple files in each folder)-->check if folder is 2 days old --> move folder out to ready folder --> copy to network --> move to completed backup
(need help for this portion)

Sub Move_Ready_Files()

'this work to move ready files. still have to click cancel for inuse files.
Dim z As String
Dim strSource As String
Dim strDest As String
Dim i As Long
'Set Source and Destination Folder paths
strSource = "D:\Latest Results\": strDest = "D:\ReadyToBackup\" ' change to suit
'Put all Folders in Source folder into an array
z = Split(CreateObject("wscript.shell").exec("cmd /c Dir """ & strSource & "*.*"" /s /b /o:n").StdOut.ReadAll, vbCrLf)
'Loop though the Array
For i = LBound(z) To UBound(z) - 1
'Move the files from each folder to the Destination Folder.. overwriting existing ones (16)..
CreateObject("shell.application").Namespace((strDest)).MoveHere (z(i)), 16
Next i

End Sub


Sub Perform_backup()

'This example copy all files and subfolders from FromPath to ToPath.
'Note: If ToPath already exist it will overwrite existing files in this folder
'if ToPath not exist it will be made for you.
Dim FSO As Object
Dim FromPath As String
Dim ToPath As String

FromPath = "D:\ReadyToBackup\" '<< Change
ToPath = "\\network\Raw Data\" & Format(Now, "yyyy-mm-dd h-mm-ss")

If Right(FromPath, 1) = "\" Then
FromPath = Left(FromPath, Len(FromPath) - 1)
End If

If Right(ToPath, 1) = "\" Then
ToPath = Left(ToPath, Len(ToPath) - 1)
End If

Set FSO = CreateObject("scripting.filesystemobject")

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

FSO.CopyFolder Source:=FromPath, Destination:=ToPath
'MsgBox "You can find the files and subfolders from " & FromPath & " in " & ToPath
'-----------------------------------------------------------------------------------------------------------------------------------

FromPath = "D:\ReadyToBackup\" '<< Change

ToPath = "D:\Completed backup\" & Format(Now, "yyyy-mm-dd h-mm-ss")

If Right(FromPath, 1) = "\" Then
FromPath = Left(FromPath, Len(FromPath) - 1)
End If

If Right(ToPath, 1) = "\" Then
ToPath = Left(ToPath, Len(ToPath) - 1)
End If

Set FSO = CreateObject("scripting.filesystemobject")

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

FSO.moveFolder Source:=FromPath, Destination:=ToPath
'MsgBox "You can find the files and subfolders from " & FromPath & " in " & ToPath

' To recreate the original folder
MkDir "D:\ReadyToBackup\"

End Sub
 

Excel Facts

How to show all formulas in Excel?
Press Ctrl+` to show all formulas. Press it again to toggle back to numbers. The grave accent is often under the tilde on US keyboards.
here is my chain of events
Data created (multiple folders with multiple files in each folder)-->check if folder is 2 days old --> move folder out to ready folder --> copy to network --> move to completed backup
(need help for this portion)
sorry slight mistake, it is to move subfolder out
Data created (multiple folders with multiple files in each folder)-->check if folder is 2 days old --> move sub folders out to ready folder --> copy to
(need help for this portion)
 
Upvote 0

Forum statistics

Threads
1,223,240
Messages
6,170,951
Members
452,368
Latest member
jayp2104

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top