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
0 komentar:
Posting Komentar