Backup Database

- Buat Project baru pada VB 6.0 -> Pilih Standar EXE
- Pilih Menu Project -> Componen (Ctrl +T) -> Beri Conteng Pada
1. Microsoft Common Dialog Control 6.0 (SP6)
2. Microsoft Windows Common Control 6.0 (SP6)
- Pilih Applay -> OK



KODE PROGRAM NYA
Private Sub Command1_Click()
On Error Resume Next
Dim buka As String
With CommonDialog1
.Filter = "MS Acces (*.mdb) |*.mdb;|Acces 2007-2010 (*.Accdb)|*.Accdb|all files|*.*"
.DialogTitle = "Open Database"
.FileName = ""
.ShowOpen
buka = .FileName
If .FileName = "" Then
Exit Sub
Else
TxtConection.Text = buka
FrmConection.Caption = "Conection OK"
End If
End With
End Sub
________________________________________
Private Sub Command2_Click()
If TxtConection.Text = "No Conection" Then
MsgBox "Can not Conect Database ! Please Chouse Database", vbCritical
Else
Me.Hide
backup.Show
End If
End Sub
________________________________________
Private Sub Command3_Click()
Unload Me
End Sub




Tool Propertis Name
Form Caption = Conection BorderStyle = 1 -FixedSingle backup
TextBox Text1
ListBox BackColor = Hijau List1
Frame Caption = Date BackColor = Hijau Frame1
Command Botton Caption = BackUp Command1
Command Botton Caption =&Tutup Command2
Command Botton Caption = &Browse Command3
Command Botton Caption = &Back Command4
ProgressBar Pb1
Label Caption = Max Date BackStyle =0-Trnsparant LbMaxDate
Label Caption = Value BackStyle =0-Trnsparant LbValue
Label Caption = Tabel BackStyle =0-Trnsparant LbTabel




KODE PROGRAM NYA
Dim rsimpor As ADODB.Recordset
________________________________________
Sub listing()
On Error Resume Next
List1.Clear
Set rs = Con.OpenSchema(adSchemaTables)
Do Until rs.EOF
If Left$(rs.Fields(2), 4) <> "MSys" Then
If rs.Fields!TABLE_TYPE = "TABLE" Then
List1.AddItem rs.Fields(2)
End If
End If
rs.MoveNext
Loop
End Sub
________________________________________
Private Sub Command1_Click()
DisConnects
FileCopy App.Path & "\kosong.mdb", Text1.Text
Connects
pb1.Value = 0
pb1.Max = List1.ListCount
With List1
For i = 0 To List1.ListCount - 1
List1.ListIndex = i
pb1.Value = i + 1
SQLImpor = "SELECT [" & List1.Text & "].*" & _
" INTO [" & List1.Text & "] IN '" & Text1.Text & _
"' FROM [" & List1.Text & "]"

Con.Execute SQLImpor

LbValue.Caption = "Value = " & pb1.Value
LbTabel.Caption = "Backup Tabel : " & List1.Text
Next i
End With
MsgBox "Back Up Data telah selesai", vbInformation
pb1.Value = 0
End Sub
________________________________________
Private Sub Command2_Click()
End
End Sub
________________________________________
Private Sub Command3_Click()
CommonDialog1.FileName = App.Path & "\backup" & Format(Date, "yymmdd")
CommonDialog1.ShowSave
Text1.Text = CommonDialog1.FileName & ".mdb"
End Sub
________________________________________



Private Sub Command4_Click()
Unload Me
FrmConection.Show
End Sub
________________________________________
Private Sub Form_Load()
Connects
listing
Text1.Text = App.Path & "\backup" & Format(Date, "yymmdd") & ".mdb"
LbMaxDate.Caption = "Max Date = " & List1.ListCount
End Sub


Download Contoh Projectnya :
beckup dbDengan VB6.0 .rar