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

Posted in: Vb