Pages - Menu
▼
Pages - Menu
▼
Pages
▼
Sunday, November 26, 2017
Ms Acces Membuat Backup Otomatis Dengan Waktu Yang Ditetukan Menggunakan Visual Basic dan Macro.
Ms Acces Membuat Backup Otomatis Dengan Waktu Yang Ditetukan Menggunakan Visual Basic dan Macro.
Untuk Tutorial Video nya terdapat di link dibawah ini.
https://www.youtube.com/watch?v=O9brWFNE97k
_______________________________________________________________
Sub BackUp()
Dim dTime As Date
On Error Resume Next
dTime = InputBox("Create a backup at", , Time + TimeValue("00:00:05"))
If Err.Number <> 0 Then Exit Sub
Do Until Time = dTime
DoEvents
Loop
MsgBox "Waktunya untuk membuat backup"
'Membuat Database baru di forder yang sama
Dim sFile As String, oDB As DAO.Database
sFile = CurrentProject.Path & "\" & Format(Date, "mm-dd-yyyy") & ".mdb"
If Dir(sFile) <> "" Then Kill sFile
Set oDB = DBEngine.Workspaces(0).CreateDatabase(sFile, dbLangGeneral)
'Copy Tabel dan / atau Query
Dim oTD As TableDef
DoCmd.Hourglass True
For Each oTD In CurrentDb.TableDefs
If Left(oTD.Name, 4) <> "MSys" Then
DoCmd.CopyObject sFile, , acTable, oTD.Name
End If
Next oTD
DoCmd.Hourglass False
MsgBox "Backup disimpan dalam folder yang sama"
End Sub
Function RunSub()
BackUp
End Function
________________________________________________________________
Untuk Tutorial Video nya terdapat di link dibawah ini.
https://www.youtube.com/watch?v=O9brWFNE97k
_______________________________________________________________
Sub BackUp()
Dim dTime As Date
On Error Resume Next
dTime = InputBox("Create a backup at", , Time + TimeValue("00:00:05"))
If Err.Number <> 0 Then Exit Sub
Do Until Time = dTime
DoEvents
Loop
MsgBox "Waktunya untuk membuat backup"
'Membuat Database baru di forder yang sama
Dim sFile As String, oDB As DAO.Database
sFile = CurrentProject.Path & "\" & Format(Date, "mm-dd-yyyy") & ".mdb"
If Dir(sFile) <> "" Then Kill sFile
Set oDB = DBEngine.Workspaces(0).CreateDatabase(sFile, dbLangGeneral)
'Copy Tabel dan / atau Query
Dim oTD As TableDef
DoCmd.Hourglass True
For Each oTD In CurrentDb.TableDefs
If Left(oTD.Name, 4) <> "MSys" Then
DoCmd.CopyObject sFile, , acTable, oTD.Name
End If
Next oTD
DoCmd.Hourglass False
MsgBox "Backup disimpan dalam folder yang sama"
End Sub
Function RunSub()
BackUp
End Function
________________________________________________________________