Serpihan Kode Database Access

Pertama yang perlu disapkan adalah :

• Nama Database : DBPembelajaran.mdb format Microsoft Office Access 2000

• Nama Tabel : SiswaLogin

• Nama Field dalam Tabel SiswaLogin : Nama Field Nama_Siswa TypeField Text dan field kedua   Nama Field NIS TypeField Text

• Klik Menu Project Pilih References.. : Microsoft ActiveX Data Object 2.0 Library atau versi yang lebih tinggi.

Dibawah ini serpihan kode yang mungkin bermanfaat, silahkan...
1. a. Koneksi Dengan Database Yang Tidak Berpassword

Option Explicit
Dim db As ADODB.Connection
Dim adoPrimaryRSLoginSiswa As ADODB.Recordset

Private Sub Form_Load()
On Error GoTo err
        Set db = New ADODB.Connection
        db.CursorLocation = adUseClient
        db.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;" & _
          "Data Source=" & App.Path & "\DBPembelajaran.mdb;"
err:
        If db.State = 1 Then
            MsgBox "Terkoneksi dengan database"
        ElseIf db.State = 0 Then
            MsgBox "Tidak Terkoneksi dengan database.", vbInformation, "Error"
        End If
End Sub
 

1. b. Koneksi Dengan Database Berpassword

Private Sub Form_Load()
On Error GoTo ERR
        Dim DBBerPassword
        Set DBBerPassword = New ADODB.Connection
        DBBerPassword.CursorLocation = adUseClient
        DBBerPassword.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\DBPembelajaran - Copy.mdb" & ";Persist Security Info=False;Mode=12;Jet OLEDB:Database Password=TulisPasswordnya"
ERR:
        If DBBerPassword.State = 1 Then
            MsgBox "Terkoneksi dengan database"
        ElseIf DBBerPassword.State = 0 Then
            MsgBox "Tidak Terkoneksi dengan database.", vbInformation, "Error"
        End If
End Sub

2. Buka Record

Private Sub Command1_Click()
On Error GoTo err
        Set adoPrimaryRSLoginSiswa = New ADODB.Recordset
        adoPrimaryRSLoginSiswa.Open "TblSiswaLogin", db, adOpenStatic, adLockOptimistic
err:
        If adoPrimaryRSLoginSiswa.State = 1 Then
            MsgBox "Terkoneksi dengan Tabel"
        ElseIf adoPrimaryRSLoginSiswa.State = 0 Then
            MsgBox "Tabel tidak ditemukan, cek kembali tabel yang ada dalam database.", vbInformation, "Error"
        End If
End Sub

3. Cek Isi Field

Private Sub Command2_Click()
    adoPrimaryRSLoginSiswa.MoveFirst
    MsgBox "NAMA FIELD : " & adoPrimaryRSLoginSiswa.Fields(0).Name & _
    vbCrLf & "ISI FIELD RECORD PERTAMA : " & adoPrimaryRSLoginSiswa.Fields(0).Value, vbInformation
End Sub

4. Menghubungkan Isi Field Ke Control

Private Sub Command3_Click()
    Set Me.Text1.DataSource = adoPrimaryRSLoginSiswa
    Set Me.Text2.DataSource = adoPrimaryRSLoginSiswa
    
    Me.Text1.DataField = "NAMA_SISWA"
    Me.Text2.DataField = "NIS"
    
End Sub

5. Mengecek Field Kosong (IsNull)

Private Sub Command4_Click()
    'DI PROPERTY Text3 MultiLine pilih True
    'DI PROPERTY Text3 ScrollBars pilih 3
    Text3.Text = "MENGECEK FIELD NIS KOSONG"
    adoPrimaryRSLoginSiswa.MoveFirst
    While Not adoPrimaryRSLoginSiswa.EOF
    If IsNull(adoPrimaryRSLoginSiswa.Fields("NIS")) = True Then
        Text3.Text = Text3.Text & vbCrLf & "NO : " & adoPrimaryRSLoginSiswa.AbsolutePosition & ". " & adoPrimaryRSLoginSiswa.Fields("NAMA_SISWA").Value & " KOSONG"
    ElseIf IsNull(adoPrimaryRSLoginSiswa.Fields("NIS")) = False Then
        Text3.Text = Text3.Text & vbCrLf & "NO : " & adoPrimaryRSLoginSiswa.AbsolutePosition & " TIDAK KOSONG "
    End If
        adoPrimaryRSLoginSiswa.MoveNext
    Wend
End Sub

6. Navigasi

Private Sub Command5_Click()
    If adoPrimaryRSLoginSiswa.AbsolutePosition = 1 Or adoPrimaryRSLoginSiswa.RecordCount = 0 Then
        Beep
    Else
        adoPrimaryRSLoginSiswa.MoveFirst 'Ke record Pertama
    End If
    Me.Label2.Caption = "NO. " & adoPrimaryRSLoginSiswa.AbsolutePosition
End Sub

Private Sub Command6_Click()
    If adoPrimaryRSLoginSiswa.AbsolutePosition = 1 Or adoPrimaryRSLoginSiswa.RecordCount = 0 Then
        Beep
    Else
        adoPrimaryRSLoginSiswa.MovePrevious "Ke record Sebelumnya    End If
    Me.Label2.Caption = "NO. " & adoPrimaryRSLoginSiswa.AbsolutePosition
End Sub

Private Sub Command7_Click()
    If adoPrimaryRSLoginSiswa.AbsolutePosition = adoPrimaryRSLoginSiswa.RecordCount Or adoPrimaryRSLoginSiswa.RecordCount = 0 Then
        Beep
    Else
        adoPrimaryRSLoginSiswa.MoveNext 'Ke record Selanjutnya    End If
    Me.Label2.Caption = "NO. " & adoPrimaryRSLoginSiswa.AbsolutePosition
End Sub

Private Sub Command8_Click()
    If adoPrimaryRSLoginSiswa.AbsolutePosition = adoPrimaryRSLoginSiswa.RecordCount Or adoPrimaryRSLoginSiswa.RecordCount = 0 Then
        Beep
    Else
        adoPrimaryRSLoginSiswa.MoveLast 'Ke record Terakhir    End If
    Me.Label2.Caption = "NO. " & adoPrimaryRSLoginSiswa.AbsolutePosition
End Sub

6. Mendapatkan Tabel Dalam database

Private Sub Command9_Click()
Dim NamaTabel As ADODB.Recordset
Set NamaTabel = db.OpenSchema(adSchemaTables)
    While Not NamaTabel.EOF
        If NamaTabel!TABLE_TYPE = "TABLE" Then Text4.Text = Text4.Text & vbCrLf & NamaTabel!TABLE_NAME
        NamaTabel.MoveNext
    Wend
End Sub

7. Mendapatkan Field Dalam Tabel

Private Sub Command10_Click()
Dim Column As ADODB.Field
If adoPrimaryRSLoginSiswa.State = adStateOpen Then
    For Each Column In adoPrimaryRSLoginSiswa.Fields
        Text5.Text = Text5.Text & vbCrLf & Column.Name
    Next
End If
End Sub

8. Membuat Tabel - Create Table

Private Sub Command11_Click()
    Dim Cmd As New ADODB.Command
    Cmd.ActiveConnection = db
    Cmd.CommandText = "create table TabelBaru (NAMA_SISWA varchar(20), KELAS varchar(5), TENTANG_SISWA LongChar, Foto LongBinary)"
    Cmd.Execute
End Sub

9. Menambahkan Field Di Tabel Yang Sudah Ada - Add Field In Exists Table

Private Sub Command12_Click()
'Tambahkan references Microsoft ADO Ext. 2.1 for DDL and Security atau versi lebih tinggi
    Dim Xconx As ADODB.Connection
    Dim Xcmd As ADODB.Command
    Dim Xrs As ADODB.Recordset
    Dim m_MDBdatabase As String
    Dim m_MDBtable As String

'Tambahkan columns di tabel yang sudah ada
    Dim ADOXcat As ADOX.Catalog
    Dim MStbl As ADOX.table
    Dim MScol As ADOX.Column
    
    m_MDBdatabase = App.Path & "\DBPembelajaran.mdb"
    m_MDBtable = "TblSiswaLogin"

'Membuat koneksi
    Set Xconx = New ADODB.Connection
    Set Xcmd = New ADODB.Command
    Set Xrs = New ADODB.Recordset
    Set Xconx = CreateObject("ADODB.Connection")
    Xconx.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
    "Persist Security Info=False;" & _
    "Data Source=" & m_MDBdatabase
    Set Xrs = CreateObject("ADODB.Recordset")
    Xrs.CursorLocation = adUseServer

'Mengirimkan MDB dan table ke catalog
    Set ADOXcat = New ADOX.Catalog
    ADOXcat.ActiveConnection = _
    "Provider=Microsoft.Jet.OLEDB.4.0;" & _
    "Data Source=" & m_MDBdatabase
    Set MStbl = ADOXcat.Tables(m_MDBtable)

'Menambahkan columns/Field ke tabel yang ada
    MStbl.Columns.Append "NILAI", adDouble
    MStbl.Columns.Append "KETERANGAN", adVarWChar, 255
    MStbl.Columns.Append "TANGGAL_LAHIR", adDate
    
'Bersihkan
    ADOXcat.ActiveConnection.Close
    Set ADOXcat = Nothing
    Set MStbl = Nothing
    Set MScol = Nothing
    Set Xconx = Nothing
    Set Xcmd = Nothing
    Set Xrs = Nothing
End Sub

10. Hapus Semua Record Dalam Tabel

Private Sub Command13_Click()
    db.Execute "DELETE FROM TBLsiswalogin"
End Sub

11. Hapus Tabel

Private Sub Command14_Click()
'Tambahkan references Microsoft DAO 3.6 Object Library atau versi lebih tinggi
    Dim ConMateri As Database, AdoDao%
    Set ConMateri = OpenDatabase(App.Path & "\DBPembelajaran.MDB", False, False, "MS Access;Pwd=dbpwd")
    Dim TbDef As TableDefs
    Set TbDef = ConMateri.TableDefs
    ConMateri.TableDefs.Delete "NamaTabelYangAkanDiHapus"
End Sub