RESTOR DATABASE dengan Vb6.0

RESTOR DATABASE

-          Buat Project baru pada VB 6.0 -> Pilih Standar EXE

-          Pilih Menu Project -> Componen (Ctrl +T) -> Beri Conteng Pada

1.      Microsoft ADO Data Control 6.0 (OLDB)

2.      Microsoft Common Dialog Control 6.0 (SP6)

3.      Microsoft Data Grid Control 6.0 (OLDB)

4.      Microsoft Windows Common Control 6.0 (SP6)

-          Pilih Applay  -> OK

Buat Rancangan Form Seperti Gambar Dibawah ini

 

Coding
Buat Modul Ketikan Code Berikut

Public Con As ADODB.Connection

Public Con1 As ADODB.Connection

Public rs As ADODB.Recordset

Public rs1 As ADODB.Recordset

---

Sub Connects()

On Error Resume Next

Set Con = New ADODB.Connection

Con.Provider = "Microsoft.Jet.OLEDB.4.0"

Con.Open FrmConection.TxtConection

End Sub

---

Sub DisConnects()

On Error Resume Next

Con.Close

End Sub

---

Sub Main()

   FrmMonitor.Show

End Sub

---

Ketikkan Kode Pada Form

Private Sub Command1_Click()                                      'Mengambil Database

On Error Resume Next

Dim buka As String

With CommonDialog1

.Filter = "MS Acces (*.mdb) |*.mdb;|Acces 2007-2010 (*.Accdb)|*.Accdb|all files|*.*" 'Menyaring Tipe Database

.DialogTitle = "Open Database"

.FileName = ""             'Membersihkan file name (URL)

.ShowOpen

buka = .FileName

If .FileName = "" Then

Exit Sub

Else

TxtConection.Text = buka                                                     'File Name (Hal Terpenting)

Label2.Caption = "Database Title = " & .FileTitle                'Nama Data

Label3.Caption = "Database Prenter = " & .PrinterDefault   'Status

Label4.Caption = "Database Copies = " & .Copies               'Jumlah Copy

Label5.Caption = "FilterIndex  = " & .FilterIndex                'Index Penyaringan data

FrmConection.Caption = "Conection OK"  'Merubah title Form

End If

End With

End Sub

---

Private Sub Command2_Click()

If TxtConection.Text = "No Conection" Then          

                           'Jika tidak ada Database yang dipilih maka

MsgBox "Can not Conect Database ! Please Chouse Database", vbCritical 'Beri Pesan

Else                    ' Jika tidak (ada database yang dipilih)

Me.Hide

Restor.Show

Restor.Label4.Caption = Label2.Caption

Restor.Label5.Caption = Label4.Caption

End If

End Sub

---

Private Sub Command3_Click()

Unload Me       'tutup Form

End Sub

 

Ketikkan pada form Kode Berikut

Dim rsimpor As ADODB.Recordset

---

Sub listing()

'Memasukkan Nama Tabel Ke List data

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()

'Kembali ke Conection Database yang Di Restor

Unload Me

FrmConection.Show

End Sub

---

Private Sub Command2_Click()

DisConnects

FileCopy App.Path & "\kosong.mdb", Text1.Text    'mengkopy data ke kosong database

Connects                                         'memutus Cinection

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

     Label3.Caption = "Backup Tabel : " & List1.Text

    Label1.Caption = "Value = " & pb1.Value

    Next i

End With

MsgBox "Back Up Data telah selesai", vbInformation

pb1.Value = 0

End Sub

---

Private Sub Command3_Click() ' Melihat Database

Unload Me

FrmMonitor.Show

End Sub

---

Private Sub Form_Load()

Connects

listing

Text1.Text = App.Path & "\Databese\db1.mdb" 'Tempat Pentimpana Database Yang di Restor

    Label2.Caption = List1.ListCount

End Sub

---

 
 

Kode :

Option Explicit

Private koneksi As ADODB.Connection

---

Private Function konek() As Boolean

    On Error GoTo out

        Set koneksi = New ADODB.Connection

        koneksi.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\Databese\db1.mdb;Persist Security Info=False"

        koneksi.CursorLocation = adUseClient

        konek = True

out:

End Function

---

Sub listing() 'Menampilkan Nama-nama Tabel Ke List & Combo box

On Error Resume Next

List1.Clear

Set Adodc2.Recordset = koneksi.OpenSchema(adSchemaTables)

    Do Until Adodc2.Recordset.EOF

        If Left$(Adodc2.Recordset.Fields(2), 4) <> "MSys" Then

            If Adodc2.Recordset.Fields!TABLE_TYPE = "TABLE" Then

                List1.AddItem Adodc2.Recordset.Fields(2)

                Combo1.AddItem Adodc2.Recordset.Fields(2)

            End If

        End If

        Adodc2.Recordset.MoveNext

    Loop

End Sub

---

Private Sub Command1_Click()

Call Form_Load

    Adodc1.ConnectionString = koneksi.ConnectionString

    Adodc1.RecordSource = Combo1

    Set DataGrid1.DataSource = Adodc1

    Label5.Caption = Adodc1.Recordset.RecordCount   'Menampilkan Jumlah Baris Tabel

    Label7.Caption = App.Path & "\Database\db1.mdb" 'Menampilkan FileName

    Text1.Text = Adodc1.ConnectionString            'Menampilkan Conection

End Sub

---

Private Sub Command2_Click() 'Disconct

 koneksi.Close

 Unload Me

 Me.Show

End Sub

---

Private Sub Command3_Click() 'Exit

End

End Sub

---

Private Sub Form_Load()

If Not konek() Then

        MsgBox "Gak bisa terhubung ke database!", vbCritical

        End

    End If

    listing  'Memanggil Prosedure Mengisi List Box

    Text1.Text = Adodc1.ConnectionString

End Sub

---

Download  Projectnya di Sini : Restor Database With VB 6.0.rar