Menampilkan Daftar Field+Type+Size Database Ms.Access Dengan ADO VB6

Berikut ini adalah cara menampilkan daftar field database Microsoft Access di visual basic 6, untuk mempraktekannya siapkan :

1. Buat 1 Project baru dengan 1 Form.
2. Tambahkan 2 ListBox, 1 Commandbutton, dan 2 Label.
3. Tambahkan reference Microsoft ActiveX Data Objects 2.0 Library dari menu Project->References...
4. Copy-kan coding berikut ke editor form yang bertalian.

          'Variabel Connection dan Recordset ADO

          Dim cnn As ADODB.Connection
          Dim rs As ADODB.Recordset

          'Buat tipe data untuk menampung data tipe dan ukuran
          Private Type arrTipe

              Tipe As String
              Ukuran As Integer
          End Type


          'Buat array dinamis bertipe arrTipe di atas
          Dim tabTipe() As arrTipe

          Private Sub DaftarTabel(Daftar As ListBox)

          On Error GoTo Pesan
              'Inisialisasi variabel Connection
              Set cnn = New ADODB.Connection
              cnn.CursorLocation = adUseClient
              'Sesuaikan lokasi database di PC Anda

              cnn.ConnectionString = _
                  "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                  "Data Source=D:\brinkster\files\ADOKontrol\mahasiswa.mdb;" & _
                  "Jet OLEDB:Database Password=;"

              cnn.Open
             
              'Buka skema tabel dengan OpenSchema
              Set rs = cnn.OpenSchema(adSchemaTables)

              'Bersihkan daftar tempat menampungnya dulu
              Daftar.Clear
              While rs.EOF <> True
                  'MSys untuk tabel sistem di MS Access
                  'sys biasanya tabel sistem di MS SQL Server

                  'Jadi, tabel sistem tidak perlu ditampilkan...
                  If Left(rs.Fields("Table_Name").Value, 4) <> "MSys" And _
                     Left(rs.Fields("Table_Name").Value, 3) <> "sys" Then
                     'Tambahkan ke daftar...

                     Daftar.AddItem rs.Fields("Table_Name")
                  End If
                  rs.MoveNext
              Wend

              'Jika sudah selesai, sorot item paling atas
              Daftar.Text = Daftar.List(0)
              Exit Sub
          Pesan:  'Jika ada error, tampilkan nomor dan deskripsinya
              MsgBox Err.Number & " - " & _

                     Err.Description, vbCritical, "Error"
          End Sub

         Private Sub Command1_Click()
            'Tampilkan daftar tabel ke List1
            Call DaftarTabel(List1)
          End Sub


          Private Sub DaftarField(NamaTabel As String, Daftar As ListBox)
          Dim Adofl As ADODB.Field, i As Integer
              'Gunakan kembali variabel rs, tapi bersihkan dulu...

              Set rs = New ADODB.Recordset
              'Buka tabel dari parameter
              rs.Open NamaTabel, cnn, adOpenKeyset, adLockOptimistic, adCmdTable
              'Alokasi ulang array dinamis untuk menampung jumlah field

              ReDim tabTipe(rs.Fields.Count)
              'Bersihkan daftar tempat menampungnya dulu
              Daftar.Clear
              'Untuk setiap Field di Recordset rs
              For Each Adofl In rs.Fields

                  'Tambahkan satu per satu ke daftar
                  Daftar.AddItem Adofl.Name
                  'Tampung ke array tipe dan ukurannya
                  tabTipe(i).Tipe = TipeField(Adofl.Type)

                  tabTipe(i).Ukuran = Adofl.DefinedSize
                  i = i + 1  'Counter untuk maju ke berikutnya
              Next
              'Setelah selesai, sorot item yang teratas

              Daftar.Text = Daftar.List(0)
          End Sub

          Private Sub Form_Load()
            'Kosongkan label mula-mula

            Label1.Caption = ""
            Label2.Caption = ""
          End Sub


          Private Sub List1_Click()
          'Jika item (namatabel) di List1 diklik, maka tampilkan
          'daftar field dari tabel ybt di List2
            Call DaftarField(List1.Text, List2)

          End Sub

          Private Sub List2_Click()
          'Jika item di List2 diklik, maka tampilkan tipe dan ukuran field-nya
          If List2.ListIndex <> -1 And _

             tabTipe(List2.ListIndex).Tipe <> "" Then
              'Tampilkan tipe dan ukurannya masing-masing
              'ke Label1 dan Label2
              Label1.Visible = True

              Label2.Visible = True
              Label1.Caption = "Tipe Field: " & tabTipe(List2.ListIndex).Tipe
              Label2.Caption = "Ukuran Field: " & tabTipe(List2.ListIndex).Ukuran
          Else

              'Jika record tidak ada...
              Label1.Visible = False
              Label2.Visible = False
          End If
          End Sub


          Public Function TipeField(intType As Integer) As String
          'Fungsi berikut untuk menentukan tipe suatu field
             Select Case intType

                Case adEmpty          '0
                  TipeField = "adEmpty"
                Case adTinyInt        '16
                  TipeField = "adTinyInt"

                Case adSmallInt       '2
                   TipeField = "adSmallInt"

                Case adInteger        '3
                  TipeField = "adInteger"
                Case adBigInt         '20
                  TipeField = "adBigInt"
                Case adUnsignedTinyInt '17

                   TipeField = "adUnsignedTinyInt"
                Case adUnsignedSmallInt '18
                  TipeField = "adUnsignedSmallInt"
                Case adUnsignedInt      '19

                  TipeField = "adUnsignedInt"
                Case adUnsignedBigInt     '21
                  TipeField = "adUnsignedBigInt"
                Case adSingle             '4

                  TipeField = "adSingle"
                Case adDouble             '5
                  TipeField = "adDouble"
                Case adCurrency           '6
                  TipeField = "adCurrency"

                Case adDecimal            '14
                  TipeField = "adDecimal"
                Case adNumeric            '131
                  TipeField = "adNumeric"

                Case adBoolean            '11
                  TipeField = "adBoolean"
                Case adError              '10
                  TipeField = "adError"

                Case adUserDefined        '132
                  TipeField = "adUserDefined"
                Case adVariant            '12
                  TipeField = "adVariant"
                Case adIDispatch          '9

                  TipeField = "adIDispatch"
                Case adIUnknown           '13
                  TipeField = "adIUnknown"
                Case adGUID               '72

                  TipeField = "adGUID"
                Case adDate               '7
                  TipeField = "adDate"
                Case adDBDate             '133

                  TipeField = "adDBDate"
                Case adDBTime             '134
                  TipeField = "adDBTime"
                Case adDBTimeStamp        '135
                  TipeField = "adDBTimeStamp"

                Case adBSTR               '8
                  TipeField = "adBSTR"
                Case adChar               '129
                   TipeField = "adChar"

                Case adVarChar            '200
                   TipeField = "adVarChar"
                Case adLongVarChar        '201
                  TipeField = "adLongVarChar"

                Case adWChar              '130
                  TipeField = "adWChar"
                Case adVarWChar           '202
                  TipeField = "adVarWChar"
                Case adLongVarWChar       '203

                  TipeField = "adLongVarWChar"
                Case adBinary             '128
                  TipeField = "adBinary"
                Case adVarBinary          '204

                  TipeField = "adVarBinary"
                Case adLongVarBinary      '205

                  TipeField = "adLongVarBinary"
                Case adChapter            '136

                  TipeField = "adChapter"
                 
                Case dbBoolean
                  TipeField = "dbBoolean"
                Case dbByte

                  TipeField = "dbByte"
                Case dbInteger
                  TipeField = "dbInteger"
                Case dbLong

                  TipeField = "dbLong"
                Case dbCurrency
                  TipeField = "dbCurrency"
                Case dbSingle

                  TipeField = "dbSingle"
                Case dbDouble
                  TipeField = "dbDouble"
                Case dbDate
                  TipeField = "dbDate"

                Case dbText
                  TipeField = "dbText"
                Case dbLongBinary
                  TipeField = "dbLongBinary"

                Case dbMemo
                  TipeField = "dbMemo"
                Case dbGUID
                  TipeField = "dbGUID"

             End Select
          End Function

          Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
              'Tutup semua variabel recordset dan connection

              rs.Close
              cnn.Close
              'Bersihkan memory yang telah digunakan
              Set rs = Nothing

              Set cnn = Nothing
          End Sub


Tags:

contoh program vb6, contoh fungsi di vb6, cara penggunaan fungsi vb, tutorial vb6, download tutorial vb6, vb6 tutorial download, dasar dasar vb6, belajar vb6, cara mudah belajar vb6, vb6 artikel download, vb6 blog, contoh program vb6, artikel vb6, semua tentang vb6, vb6 api, cara menggunakan module, cara menggunakan class module