Berikut ini source code yang bisa Anda gunakan untuk membuat tabel saat run-time di program Anda dengan menggunakan ADO dan database Microsoft Access 2000. Untuk mencoba code ini, jangan lupa agar Anda membuat terlebih dulu satu buah database Access kosong (blank database, tanpa tabel) lalu simpan di C:\ dengan nama NewDB.mdb. Anda juga harus menambahkan dua item dari menu Project -> References... punya Visual Basic 6, masing-masing: "Microsoft ActiveX Data Objects 2.x Library" dan "Microsoft ADO Ext. 2.x for DDL and Security".
Deskripsi:
Deskripsi:
Membuat tabel saat run-time dengan reference ADO menggunakan
database Microsoft Access 2000. Dalam code ini, Anda harus
menambahkan dua item sebagai reference untuk code, yaitu:
"Microsoft ActiveX Data Objects 2.x Library" dan
"Microsoft ADO Ext. 2.x for DDL and Security".
MDAC versi terakhir yang terinstall di PC saya adalah versi 8
sehingga 2.x itu menjadi 2.8. Sesuaikan di PC Anda.
database Microsoft Access 2000. Dalam code ini, Anda harus
menambahkan dua item sebagai reference untuk code, yaitu:
"Microsoft ActiveX Data Objects 2.x Library" dan
"Microsoft ADO Ext. 2.x for DDL and Security".
MDAC versi terakhir yang terinstall di PC saya adalah versi 8
sehingga 2.x itu menjadi 2.8. Sesuaikan di PC Anda.
Persiapan:
1. Buat satu project standard exe dengan satu Form dan
satu control CommandButton di atas form.
2. Buat sebuah database baru Access 2000 kosong tanpa tabel
dan simpan di drive "C:\" dengan nama "NewDB.mdb".
3. Klik menu Project -> References... lalu beri tanda
centang pada "Microsoft ActiveX Data Objects 2.x Library"
di mana x = versi dari MDAC yang terinstall di PC Anda
4. Beri tanda centang juga di "Microsoft ADO Ext. 2.x for
DDL and Security".
5. Copy-kan code berikut ke editor form yang bertalian.
satu control CommandButton di atas form.
2. Buat sebuah database baru Access 2000 kosong tanpa tabel
dan simpan di drive "C:\" dengan nama "NewDB.mdb".
3. Klik menu Project -> References... lalu beri tanda
centang pada "Microsoft ActiveX Data Objects 2.x Library"
di mana x = versi dari MDAC yang terinstall di PC Anda
4. Beri tanda centang juga di "Microsoft ADO Ext. 2.x for
DDL and Security".
5. Copy-kan code berikut ke editor form yang bertalian.
Kode::
'--- Copy Code Dibawah Ini Pada Kolom Form Code Editor , Deskripsi General ---'
Private Sub InsertInitialData()
Dim rsTabelBaru As ADODB.Recordset
Set rsTabelBaru = New ADODB.Recordset
'Optimalkan variable ADODB.Recordset
With rsTabelBaru
.ActiveConnection = "Provider='Microsoft.Jet.OLEDB.4.0';" & _
"Data Source='C:\NewDB.mdb';"
.CursorLocation = adUseClient '<-- jangan pernah lupa ini .CursorType = adOpenKeyset '<-- biasa .LockType = adLockPessimistic '<-- biasa .Source = "SELECT * FROM TabelBaru" .Open 'Tambah record baru jika tabel sudah ada .AddNew .Fields("KodeData").Value = 1 .Fields("DeskripsiData").Value = "Deskripsi Satu" .Update MsgBox "Sukses tambah 1 record baru", vbInformation End With End Sub Private Function CreateTable() As Boolean Dim catDatabase As ADOX.Catalog Dim oTable As ADOX.Table Dim bCreateTable As Boolean On Error GoTo KeluarErr 'Di sini tabel belum terbentuk bCreateTable = False 'Variable untuk membuat tabel baru Set catDatabase = New ADOX.Catalog With catDatabase .ActiveConnection = "Provider='Microsoft.Jet.OLEDB.4.0';" & _ "Data Source='C:\NewDB.mdb';" 'Tentukan nama tabel baru yang akan dibuat Set oTable = .Tables("TabelBaru") End With KeluarProsedur: If (bCreateTable) Then Set oTable = New ADOX.Table With oTable .Name = "TabelBaru" 'Tambahkan 2 field baru Call .Columns.Append("KodeData", adInteger) Call .Columns.Append("DeskripsiData", adVarWChar, 20) End With 'Tambahkan tabel baru ke database Call catDatabase.Tables.Append(oTable) End If 'Bersihkan memory If (Not catDatabase Is Nothing) Then Set catDatabase = Nothing End If 'Tabel sudah terbentuk CreateTable = bCreateTable KeluarErr: Select Case Err.Number Case 3265 'Table belum ada bCreateTable = True Err.Clear Resume KeluarProsedur Case Is <> 0
MsgBox Err.Description, vbCritical
bCreateTable = False
Err.Clear
Resume KeluarProsedur
End Select
End Function
Private Sub Command1_Click()
On Error GoTo ErrHandler
Dim bTableCreated As Boolean
bTableCreated = CreateTable
If (bTableCreated) Then
Call InsertInitialData
End If
MsgBox "Sukses membuat tabel baru di database C:\NewDB.mdb!", vbInformation
Exit Sub
ErrHandler:
MsgBox Err.Description
End Sub
Dim rsTabelBaru As ADODB.Recordset
Set rsTabelBaru = New ADODB.Recordset
'Optimalkan variable ADODB.Recordset
With rsTabelBaru
.ActiveConnection = "Provider='Microsoft.Jet.OLEDB.4.0';" & _
"Data Source='C:\NewDB.mdb';"
.CursorLocation = adUseClient '<-- jangan pernah lupa ini .CursorType = adOpenKeyset '<-- biasa .LockType = adLockPessimistic '<-- biasa .Source = "SELECT * FROM TabelBaru" .Open 'Tambah record baru jika tabel sudah ada .AddNew .Fields("KodeData").Value = 1 .Fields("DeskripsiData").Value = "Deskripsi Satu" .Update MsgBox "Sukses tambah 1 record baru", vbInformation End With End Sub Private Function CreateTable() As Boolean Dim catDatabase As ADOX.Catalog Dim oTable As ADOX.Table Dim bCreateTable As Boolean On Error GoTo KeluarErr 'Di sini tabel belum terbentuk bCreateTable = False 'Variable untuk membuat tabel baru Set catDatabase = New ADOX.Catalog With catDatabase .ActiveConnection = "Provider='Microsoft.Jet.OLEDB.4.0';" & _ "Data Source='C:\NewDB.mdb';" 'Tentukan nama tabel baru yang akan dibuat Set oTable = .Tables("TabelBaru") End With KeluarProsedur: If (bCreateTable) Then Set oTable = New ADOX.Table With oTable .Name = "TabelBaru" 'Tambahkan 2 field baru Call .Columns.Append("KodeData", adInteger) Call .Columns.Append("DeskripsiData", adVarWChar, 20) End With 'Tambahkan tabel baru ke database Call catDatabase.Tables.Append(oTable) End If 'Bersihkan memory If (Not catDatabase Is Nothing) Then Set catDatabase = Nothing End If 'Tabel sudah terbentuk CreateTable = bCreateTable KeluarErr: Select Case Err.Number Case 3265 'Table belum ada bCreateTable = True Err.Clear Resume KeluarProsedur Case Is <> 0
MsgBox Err.Description, vbCritical
bCreateTable = False
Err.Clear
Resume KeluarProsedur
End Select
End Function
Private Sub Command1_Click()
On Error GoTo ErrHandler
Dim bTableCreated As Boolean
bTableCreated = CreateTable
If (bTableCreated) Then
Call InsertInitialData
End If
MsgBox "Sukses membuat tabel baru di database C:\NewDB.mdb!", vbInformation
Exit Sub
ErrHandler:
MsgBox Err.Description
End Sub
0 komentar:
Posting Komentar