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