Sunday, May 22, 2011

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

14 comments:

  1. Sama-sama Mas Maradona semoga bermanfaat dan sukses untuk Anda ^_^

    ReplyDelete
  2. oia tmn cm mw ksh sran ni,, klo bs ad gambarnya... pke printscreen aj... agar mempermudah dlm mncoba. mksh ya..

    ReplyDelete
  3. Makasih Mbak Liza El Fitry..^_^
    Sarannya sangat diterima, saya persiapkan dulu gambar dan projectnya agar bisa ddownload dan diimplementasikan di komputer teman2 semua..
    Makasih Mbak..

    ReplyDelete
  4. kakak gimana cara belajar dasarnya.. aq masih awam bgt nih sama yg ginian.. tolong di pandu ya kakak???? makasih

    ReplyDelete
  5. Thanks infonya gan,nambah ilmu bwt saya yang baru belajar..

    ReplyDelete
  6. gunanya buat apa nih mas VBasic ?

    ReplyDelete
  7. Belum memiliki VB6 dan Microsoft Office Ascces 2000 gan bisa di bantu? Belajar Forex Gratis

    ReplyDelete
  8. wah oke banget nih makasih bagi ilmu...

    ReplyDelete
  9. makasih, ini sangat membantu saya yang sedang belajar database hehe...

    ReplyDelete
  10. Apakah Anda masih menggunakan Microsoft Office? Barangkali mau coba-coba.

    Kingsoft Office Alternatif Terbaik Microsoft Office Saat Ini

    Kenalan, ya? :)

    ReplyDelete
  11. wahh mantap banget,,, bang VBasicCode,,, ane mau tanya nih,,, gimana cara bikin access terhubung ke vb,, trus terhubung juga ke printer????

    kalo bisa ,, saya boleh ta alamat emailnya???

    ReplyDelete
  12. thanks gan,sangat membantu untuk skripsi ane...kalo ada yg lain bagi2 yak

    ReplyDelete
  13. Ternyata yg aku Cari-2 selama ini

    ada disini


    --> TERIMA KASIH buanget

    ReplyDelete