contoh2

1.	Module

Public Conn As New ADODB.Connection 'untuk koneksi
Public Rs As New ADODB.Recordset 'membedakan tabel
Public StrConnect As String 'membaca text
Public StrSQL As String
Public Sub konek()
StrConnect = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + App.Path + "\db_sekolah.mdb" 'menentukan provider dan tempat databasenya
    If Conn.State = adStateOpen Then 'jika database dalam kondisi terbuka
        Conn.Close 'maka ditutup
    Else 'jika tidak
        Conn = New ADODB.Connection
        Conn.Open StrConnect
    End If
End Sub

2.	Script Login

Private Sub cmdBatal_Click()
    txtUsername.Text = ""
    txtPassword.Text = ""
    cmbhakAkses.Text = ""
End Sub

Private Sub cmdMasuk_Click()
    If txtUsername.Text = "" And txtPassword.Text = "" Then
        MsgBox "Anda belum mengisikan Username & Password!", vbExclamation + vbOKOnly, "Informasi"
        txtUsername.SetFocus
    ElseIf txtUsername.Text = "" Then
        MsgBox "Anda belum mengisikan Username!", vbExclamation + vbOKOnly, "Informasi"
        txtUsername.SetFocus
    ElseIf txtPassword.Text = "" Then
        MsgBox "Anda belum mengisikan Password!", vbExclamation + vbOKOnly, "Informasi"
        txtPassword.SetFocus
    Else
        StrSQL = "SELECT * FROM login WHERE nama ='" & txtUsername.Text & "'"
        Set Rs = Conn.Execute(StrSQL)
        If Rs.EOF Then
            MsgBox "Username yang Anda masukkan salah!", vbCritical, "Informasi"
            txtUsername.SetFocus
        ElseIf txtPassword.Text <> Rs("sandi") Then
            MsgBox "Password yang Anda masukkan salah!", vbCritical, "Informasi"
            txtPassword.SetFocus
        Else
            MsgBox "Login Berhasil!", vbInformation + vbOKOnly, "Informasi"
            Menu.Show
        End If
    End If
    Unload Me
End Sub

Private Sub Form_Load()
Call konek
End Sub

Private Sub txtPassword_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
    cmdMasuk.SetFocus
End If
End Sub

Private Sub txtUsername_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
    txtPassword.SetFocus
End If
End Sub

3.	Script pada form siswa

Private Sub cmdBatal_Click()
    Call BERSIH
End Sub

Private Sub cmdCari_Click()
    Call KEADAANTEKS(False)
    If (txtCari.Text = "") Then
        MsgBox "NIS yang dicari belum diisi!", vbInformation + vbOKOnly, "Infomasi"
    Else
        StrSQL = "SELECT * FROM siswa WHERE NIS ='" & txtCari.Text & "'"
        Set Rs = Conn.Execute(StrSQL)
        If Rs.EOF Then
            MsgBox "Siswa dengan NIS tersebut tidak ada!", vbInformation + vbOKOnly, "Informasi"
            Call BERSIH
            txtCari.Text = ""
        Else
            txtNIS.Text = "" + Rs("NIS")
            txtNama.Text = "" + Rs("Nama")
            txtTanggal.Text = "" + Rs("TTL")
            txtAlamat.Text = "" + Rs("Alamat")
        End If
    End If
End Sub

Private Sub cmdEdit_Click()
    If (txtCari.Text = "") Then
        MsgBox "Silahkan cari data yg akan di edit!", vbInformation + vbOKOnly, "Informasi"
    Else
        Call KEADAANTEKS(True)
        cmdUpdate.Enabled = True
        cmdSimpan.Enabled = False
        cmdBatal.Enabled = False
    End If
End Sub

Private Sub cmdHapus_Click()
    Dim pesan As Integer
    If (txtCari.Text = "") Then
        MsgBox "Silahkan cari data yg akan di hapus!", vbInformation + vbOKOnly, "Informasi"
    Else
        pesan = MsgBox("Apakah anda yakin akan mengahpus data ini ?", vbQuestion + vbYesNo, "Konfirmasi")
        If pesan = 6 Then
        StrSQL = "DELETE FROM siswa Where NIS='" & txtCari.Text & "'"
        Conn.Execute (StrSQL)

        Call REFRESHDATA

        txtCari.Text = ""
        Call BERSIH
        MsgBox "Data berhasil di hapus!", vbInformation + vbOKOnly, "Informasi"
        End If
    End If

    'Dim cari As String
    'cari = InputBox("Masukan NIS yang akan di hapus!", "Hapus Data")
    'Adodc1.Recordset.Find "NIS='" & cari & "'"
    'If Not Adodc1.Recordset.EOF Then
        'Adodc1.Recordset.Delete
        'MsgBox "Data berhasil di hapus!", vbInformation + vbOKOnly, "Informasi"
    'End If
End Sub

Private Sub cmdSimpan_Click()
    If (txtNIS.Text = "") Then
        MsgBox "Data belum diisi!, Silahkan diisi!", vbExclamation + vbOKOnly, "Informasi"
    Else
        StrSQL = "SELECT NIS FROM siswa WHERE NIS='" & txtNIS.Text & "'"
        Set Rs = Conn.Execute(StrSQL)
        If Not Rs.EOF Then
            MsgBox "NIS sudah ada, silahkan isi baru!", vbInformation + vbOKOnly, "Informasi"
            txtNIS.SetFocus
            Call BERSIH
        Else
            StrSQL = "INSERT INTO siswa(NIS, Nama, TTL, Alamat) values ('" & txtNIS.Text & "','" & txtNama.Text & "','" & txtTanggal.Text & "','" & txtAlamat.Text & "')"
            Conn.Execute (StrSQL)
            MsgBox "Apa yakin data akan di simpan?", vbQuestion + vbOKCancel, "Konfirmasi"
            Call REFRESHDATA
            Call BERSIH
            Call KEADAANTEKS(False)
            cmdSimpan.Enabled = False
            cmdBatal.Enabled = False
        End If
    End If
End Sub

Private Sub cmdTambah_Click()
    Call KEADAANTEKS(True)
    cmdSimpan.Enabled = True
    cmdBatal.Enabled = True
    txtNIS.SetFocus
    Call BERSIH
End Sub

Private Sub cmdUpdate_Click()
    StrSQL = "SELECT NIS FROM siswa WHERE NIS='" & txtNIS.Text & "'"
    Set Rs = Conn.Execute(StrSQL)
    If (txtNIS.Text <> txtCari.Text) And (Not Rs.EOF) Then
        MsgBox "NIS tersebut sudah ada!", vbInformation + vbOKOnly, "Information"
        txtNIS.SetFocus
    Else
        StrSQL = "UPDATE siswa SET NIS='" & txtNIS.Text & "', Nama='" & txtNama.Text & "', TTL='" & txtTanggal.Text & "', Alamat='" & txtAlamat.Text & "' WHERE NIS='" & txtCari.Text & "'"
        Conn.Execute (StrSQL)
        MsgBox "Apa yakin data akan di edit?", vbQuestion + vbOKCancel, "Konfirmasi"
        Call REFRESHDATA
        Call BERSIH
    End If
End Sub

Private Sub Form_Load()
    Call REFRESHDATA
    Call KEADAANTEKS(False)

    cmdSimpan.Enabled = False
    cmdBatal.Enabled = False
    cmdUpdate.Enabled = False
End Sub

Sub BERSIH()
    txtNIS.Text = ""
    txtNama.Text = ""
    txtTanggal.Text = ""
    txtAlamat.Text = ""
End Sub

Sub REFRESHDATA()
    Call konek
    Adodc1.ConnectionString = StrConnect
    Adodc1.RecordSource = "siswa"
    Adodc1.Refresh
    Set DataGrid1.DataSource = Adodc1
    DataGrid1.Refresh
    Set Conn = New ADODB.Connection
    Conn.Open StrConnect
End Sub

Sub KEADAANTEKS(stat As Boolean)
    txtNIS.Enabled = stat
    txtNama.Enabled = stat
    txtTanggal.Enabled = stat
    txtAlamat.Enabled = stat
End Sub

Private Sub txtAlamat_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        cmdSimpan.SetFocus
    End If
End Sub

Private Sub txtCari_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        cmdCari.SetFocus
    End If
End Sub

Private Sub txtNama_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        txtTanggal.SetFocus
    End If
End Sub

Private Sub txtNIS_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        txtNama.SetFocus
    End If
End Sub

Private Sub txtTanggal_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        txtAlamat.SetFocus
    End If
End Sub

4.	Script Report

Private Sub cmdCetakSiswa_Click()
Set DataReport1.DataSource = Adodc1
DataReport1.Refresh
DataReport1.WindowState = 2
DataReport1.Show
Adodc1.Refresh
End Sub

Private Sub Form_Load()
Call konek
Adodc1.ConnectionString = StrConnect
Adodc1.RecordSource = "siswa"
Adodc1.Refresh
Set DataGrid1.DataSource = Adodc1
DataGrid1.Refresh
Set Conn = New ADODB.Connection
Conn.Open StrConnect
End Sub

5.	Script Memanggil data dalam table lain

Private Sub cmbnorek_Click()
StrSQL = "SELECT * FROM Pelanggan WHERE No_Rek='" & cmbnorek.Text & "'"
Set Rs = Conn.Execute(StrSQL)
lblnama.Caption = "" & Rs.Fields("Nama")
txtabodemen.Text = "" & Rs.Fields("Abodemen")
End Sub