- 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.
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
