Elapse Time, Percent, File Count, Folder Size, Progress Bar
Sub BackUp_Folder()
Dim fso As Object
Set fso = VBA.CreateObject("Scripting.FileSystemObject")
'Reading from Database cell
Dim n As Long
Dim db As DAO.Database
Dim rs As DAO.Recordset
Set db = CurrentDb
Set rs = db.OpenRecordset("select * from tbl_Back_Up")
rs.MoveFirst
Do While Not rs.EOF ' Loop until end of file
rs.Edit
ID_var = rs.Fields("[ID]")
FromFile_var = rs.Fields("[FromFile]")
ToFile_var = rs.Fields("[ToFile]")
rs.MoveNext
Dim fsoFolder As Object
strFolderName = FromFile_var
Set fso = CreateObject("Scripting.FileSystemObject")
Set fsoFolder = fso.GetFolder(strFolderName)
FileSize = fsoFolder.Size
FileSize2 = FileSize
FileSize = 0
FileSize3 = FileSize2 + FileSize
TotalFileSize = TotalFileSize + FileSize3
Set fso = CreateObject("Scripting.FileSystemObject")
Set objFiles = fso.GetFolder(FromFile_var).Files
FileCount = objFiles.Count
FileCount2 = FileCount
FileCount = 0
FileCount3 = FileCount2 + FileCount
TotalFileCount = TotalFileCount + FileCount3
Loop
rs.Close: Set rs = Nothing
db.Close: Set db = Nothing
MyDate = Format(Date, "YYYYMMDD")
Close
'Reading from Database cell
'Show the hour glass
DoCmd.Hourglass True
Set db = CurrentDb
Set rs = db.OpenRecordset("select * from tbl_Back_Up")
rs.MoveLast 'Needed to get the accurate number of records
'Show the progress bar
SysCmd acSysCmdInitMeter, "working...", rs.RecordCount
rs.MoveFirst
MyTotalTime = Time
Do While Not rs.EOF ' Loop until end of file
MyTime = Time
rs.Edit
ID_var = rs.Fields("[ID]")
FromFile_var = rs.Fields("[FromFile]")
ToFile_var = rs.Fields("[ToFile]")
'Update the progress bar
n = n + 1
SysCmd acSysCmdUpdateMeter, n
'Keep the application responding (optional)
DoEvents
rs.MoveNext
Call fso.CopyFolder(FromFile_var, ToFile_var)
strFolderName = FromFile_var
Set fso = CreateObject("Scripting.FileSystemObject")
Set fsoFolder = fso.GetFolder(strFolderName)
FileSize = fsoFolder.Size
Percent = Round((FileSize / TotalFileSize) * 100, 2)
ElapseTime = Time - MyTime
ElapseTime = Format(ElapseTime, "hh:mm:ss")
Set fso = CreateObject("Scripting.FileSystemObject")
Set objFiles = fso.GetFolder(FromFile_var).Files
FileCount = objFiles.Count
MsgBox ("Percent of " & Percent & "% with a Elapse time of " & ElapseTime & " and a file count for " & FileCount)
Loop
ElapseTotalTime = Time - MyTotalTime
ElapseTotalTime = Format(ElapseTotalTime, "hh:mm:ss")
rs.Close: Set rs = Nothing
db.Close: Set db = Nothing
Set fsoFolder = Nothing
Set fso = Nothing
'Remove the progress bar
SysCmd acSysCmdRemoveMeter
'Show the normal cursor again
DoCmd.Hourglass False
MsgBox (MyDate & " - The back Up process is completed. Elapse Time: " & ElapseTotalTime & " and a File Count of " & TotalFileCount)
End Sub