Tutorial Contoh Program Database Sederhana dengan Microsoft Visual Basic 6.0

Akhir-akhir lebih sering lihat-lihat postingan di blog ini…akhirnya jadi ingat pernah bikin tutorial buat bantu teman belajar database di Microsoft Visual Basic 6. Pertama kali yang dipelajari tentunya menggunakan database Microsoft Access.

Waktu itu aku kasih aja langkah-langkah buat program database yang sederhana.

Contoh project Microsoft Visual Basic 6.0 menggunakan database Microsoft Access step by step:

Langkah-langkah

1. Buat project baru

File - New Project

Pilih STANDAR EXE kemudian klik OK

2. Tambahkan komponen pada toolbox. Klik kanan pada toolbox - component - Microsoft Datagrid Control 6.0 (OLEDB) - OK
3. Aturlah property formnya sebagai berikut :

• Name       : Frm_Utama
• Caption    :  ..::|| Data Teman ||::..

4. Pada Frm_Utama aturlah objek-objek seperti tampilan berikut :

Obyek	Property	Setting
Label1	Caption	Nama
Label2	Caption	Alamat
Label3	Caption	TTL
Label4	Caption	Telp
Text1	Name Text	TNama
Text2	Name Text	TAlamat
Text3	Name Text	TLahir
Text4	Name Text	TTelp
Command1	Name Caption	CmdBaru Baru
Command2	Name Caption	CmdSimpan Simpan
Command3	Name Caption	CmdEdit Edit
Command4	Name Caption	CmdUpdate Update
Command5	Name Caption	CmdBatal Batal
Command6	Name Caption	CmdHapus Hapus
DataGrid1	Name AllowUpdate	DB False

5. Buat database data teman.Mdb

a.   Dari jendela Visual Basic Klik menu Add-Ins dan pilih Visual Data Manager dan akan muncul tampilan sbb:

b.   Klik menu File - New - Microsoft Acces kemudian pilihlah Version 7.0 seperti gambar berikut :

 c.   Selanjutnya ditampilkan kotak dialog Select Microsoft Acces Database to Create. Tentukan tempat untuk menyimpan database yang dibuat dengan nama DataTeman. Seperti pada gambar berikut :

d.   Klik Save

6. Buat table Data Teman

a.    Klik kanan pada jendela Database window, kemudian pilihlah New Table dari popup menu yang ditampilkan.

Sehingga ditampilkan jendela berikutnya dengan nama Table Structure, ketikkan nama tabelnya = TTeman pada kotak Table Name

b.    Klik tombol Add field untuk membuat field baru dan buatlah field sbb :

Nama_Field	Type	Size
Nama	Text	50
Alamat	Memo
Lahir	Text	30
Telp	Text	20

c.    Deklarasikan variable untuk membuka database

Option Explicit

'Koneksi merupakan variabel untuk dihubungkan dengan file databasenya

Public Koneksi As New ADODB.Connection

'rsteman merupakan variabel untuk memanggil data record

Public Rsteman As New ADODB.Recordset

d.    Buat prosedur (Sub) untuk membuka database

Private Sub BukaDatabase()

'Perintah untuk memanggil database

    Koneksi.CursorLocation = adUseClient

    Koneksi.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=E:\Chinta's documents\Kul\temen\23 Agt 07\DataTeman.mdb;Persist Security Info=False"

‘(Jika tidak tau provider maka tambahkan adodc dan konekkan terus copy conection stringnya)
'Untuk alamat file databasenya bisa dibuat dinamis mengikuti alamat aplikasi dengan mengganti:
 Koneksi.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=E:\Chinta's documents\Kul\temen\23 Agt 07\DataTeman.mdb;Persist Security Info=False" 
menjadi
Koneksi.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "DataTeman.mdb;Persist Security Info=False" 

'perintah untuk memanggil record dari masing2 tabel

    Rsteman.Open "tteman", Koneksi, adOpenStatic, adLockOptimistic

End Sub

e.    Dan  ketik Script dibawah ini

·         Script pada Tombol Baru

Private Sub CmdBaru_Click()

‘Untuk membersihkan field ketika tombol baru diklik

    TNama.Text = ""

    TAlamat.Text = ""

    TLahir.Text = ""

    TTelp.Text = ""

‘untuk meletakkan kursor pada TNama Saat Tombol baru diklik

    TNama.SetFocus

    buka

    CmdBaru.Enabled = False

    CmdSimpan.Enabled = True

    CmdEdit.Enabled = False

    CmdUpdate.Enabled = False

    CmdBatal.Enabled = True

    CmdHapus.Enabled = False

End Sub

·         Script pada Tombol Batal

Private Sub CmdBatal_Click()

    kunci

    CmdBaru.Enabled = True

    CmdSimpan.Enabled = False

    CmdEdit.Enabled = True

    CmdUpdate.Enabled = False

    CmdBatal.Enabled = False

    CmdHapus.Enabled = True

End Sub

·         Script pada Tombol Edit

Private Sub CmdEdit_Click()

‘untuk memanggil procedure buka

    buka

    CmdBaru.Enabled = False

    CmdSimpan.Enabled = False

    CmdEdit.Enabled = False

    CmdUpdate.Enabled = True

    CmdBatal.Enabled = True

    CmdHapus.Enabled = False

End Sub

·         Script pada Tombol Hapus

Private Sub CmdHapus_Click()

‘ketika tidak ada data yang dihapus maka tidak eror

    If Rsteman.RecordCount = 0 Then Exit Sub

‘ketika kursor tidak pada grid maka tdk eror

        If Rsteman.AbsolutePosition < 0 Then

            MsgBox "Pilih yang akan dihapus", vbOKOnly + vbInformation, "Info"

        End If

‘perintah utnuk menghapus data

    Rsteman.Delete

End Sub

·         Script pada Tombol Simpan

Private Sub CmdSimpan_Click()

    'Rsteman nama variabel u/ memanggil data record

    'jika menggunakan komponen adodc maka scriptx adodc1.recordset.addnew

    Rsteman.AddNew

    Rsteman.Fields(0).Value = Trim(TNama.Text)

    Rsteman.Fields(1).Value = Trim(TAlamat.Text)

    Rsteman.Fields(2).Value = Trim(TLahir.Text)

    Rsteman.Fields(3).Value = Trim(TTelp.Text)

    Rsteman.Update

    kunci

    CmdBaru.Enabled = True

    CmdSimpan.Enabled = False

    CmdEdit.Enabled = True

    CmdUpdate.Enabled = False

    CmdBatal.Enabled = False

    CmdHapus.Enabled = True

End Sub

·         Script pada Tombol Update

Private Sub CmdUpdate_Click()

    Rsteman.Fields(0).Value = Trim(TNama.Text)

    Rsteman.Fields(1).Value = Trim(TAlamat.Text)

    Rsteman.Fields(2).Value = Trim(TLahir.Text)

    Rsteman.Fields(3).Value = Trim(TTelp.Text)

    Rsteman.Update

    kunci

    CmdBaru.Enabled = True

    CmdSimpan.Enabled = False

    CmdEdit.Enabled = True

    CmdUpdate.Enabled = False

    CmdBatal.Enabled = False

    CmdHapus.Enabled = True

End Sub

·         Script pada DataGrid

Private Sub DB_RowColChange(LastRow As Variant, ByVal LastCol As Integer)

    TNama.Text = Rsteman.Fields(0).Value

    TAlamat.Text = Rsteman.Fields(1).Value

    TLahir.Text = Rsteman.Fields(2).Value

    TTelp.Text = Rsteman.Fields(3).Value

End Sub

·         Script pada Form load

Private Sub Form_Load()

    'untuk membuka/mengkonekkan databasenya

    BukaDatabase

    'untuk menghubungkan datagrid ke datasource

    Set DB.DataSource = Rsteman

    kunci

    CmdBaru.Enabled = True

    CmdSimpan.Enabled = False

    CmdEdit.Enabled = True

    CmdUpdate.Enabled = False

    CmdBatal.Enabled = False

    CmdHapus.Enabled = True

End Sub

·         Procedure Buka

Private Sub buka()

    TNama.Locked = False

    TAlamat.Locked = False

    TLahir.Locked = False

    TTelp.Locked = False

End Sub

·         Procedure Kunci

Private Sub kunci()

    TNama.Locked = True

    TAlamat.Locked = True

    TLahir.Locked = True

    TTelp.Locked = True

End Sub

Cara Membaca/Import File Text Hasil WinAudit ke Dalam Tabel Database Menggunakan ADO di Microsoft Visual Basic 6.0

 

Kalau anda bekerja menjadi tenaga IT di sebuah perusahaan yang mengutamakan penggunaan software yang legal, pasti anda akan kenal dengan software gratisan WinAudit. WinAudit adalah software sederhana yang digunakan untuk mendata informasi sebuah komputer termasuk software yang terinstall di komputer tersebut. Biasanya perusahaan yang beritikad baik terhadap HKI akan ikut Piagam HKI yang diselenggarakan oleh BSA bekerjasama dengan Kepolisian Republik Indonesia.

Informasi lengkap tentang cara pendaftaran Piagam HKI bisa diakses melalui situs resminya http://piagam-hki.org/. Sedangkan informasi tentang BSA serta merek software yang tergabung dalam BSA bisa dilihat di situs resminya http://www.bsa.org/country.aspx?sc_lang=id-ID (bahasa Indonesia).

BSA akan mengirimkan auditor untuk mengaudit semua komputer yang ada di perusahaan. Jika perusahaan tersebut bisa comply atau bisa membuktikan bahwa software yang digunakan legal dengan bukti-bukti lisensi, maka atas persetujuan piagam HKI, perusahaan tersebut akan diberikan reward berupa piagam HKI.

Hubungannya dengan hal tersebut, auditor yang dikirim untuk mengaudit komputer kadang-kadang menggunakan software WinAudit. Agar memudahkan kita dan auditor, sebaiknya kita harus melakukan internal audit dulu dan mempersiapkan dokumen lisensinya untuk diberikan kepada auditor nanti. Software gratisan yang bisa digunakan adalah winaudit.

Hasil pendataan winaudit bisa disimpan dengan berbagai macam tipe file termasuk file text (.txt). Satu komputer akan menghasilkan satu file hasil winaudit. Jika jumlah komputer yang diaudit cukup banyak, tentunya kita akan kesulitan membaca satu-satu file hasil winaudit tersebut dan menghitung jumlah softwarenya secara manual. Hal itu juga yang menjadi permasalahan saya waktu itu.

Untuk mempermudah penghitungan software hasil winaudit tersebut, akhirnya saya mencoba untuk membuat program kecil-kecilan di Microsoft Visual Basic 6.0 untuk membaca semua file hasil winaudit dan meng-importnya menjadi satu dalam file database agar lebih mudah untuk dioproses.

Berikut akan saya paparkan langkah-langkah yang saya pikirkan waktu membuat program tersebut.

Bismillahirrohmanirrohiim...!

Langkah Pertama: Mempersiapkan Database

Tentunya kita harus mempersiapkan databasenya terlebih dahulu sebagai tempat penyimpanan data hasil import dari file winaudit. Untuk menentukan field apa saja yang digunakan, bisa kita sesuaikan dengan kebutuhan dan mengacu pada file hasil winaudit. Untuk mempermudah, saya buat dan buka databasenya menggunakan script dalam sebuah module. Berikut adalah scriptnya:

'================

Option Explicit

'untuk buat database

Public XDBAuditReport As New ADOX.Catalog

Public XTblInstalledSoftware As New ADOX.Table

Public XTblInstalledPrograms As New ADOX.Table

Public XTblOperatingSystem As New ADOX.Table.

'untuk buka database

Public CnDBAuditReport As New ADODB.Connection

Public RsInstalledSoftware As New ADODB.Recordset

Public RsInstalledPrograms As New ADODB.Recordset

Public RsOperatingSystem As New ADODB.Recordset

Sub BuatDB(Alamatnya As String)

XDBAuditReport.Create "Provider=Microsoft.jet.oledb.4.0;data source=" & Alamatnya

XDBAuditReport.ActiveConnection = "Provider=Microsoft.jet.oledb.4.0;data source=" & Alamatnya

'=============================

'tabel tblInstalledSoftware

XTblInstalledSoftware.Name = "TblInstalledSoftware"

XTblInstalledSoftware.Columns.Append "No", adInteger 'buat auto number

XTblInstalledSoftware.Columns.Append "Komputer", adVarWChar, 30

XTblInstalledSoftware.Columns.Append "AuditDate", adVarWChar, 30

XTblInstalledSoftware.Columns.Append "SWName", adVarWChar, 100

XTblInstalledSoftware.Columns.Append "Version", adVarWChar, 16

XTblInstalledSoftware.Columns.Append "Installed", adVarWChar, 3

With XTblInstalledSoftware.Columns!No

Set .ParentCatalog = XDBAuditReport

.Properties("Autoincrement") = True 'AutoNumber.

End With

XDBAuditReport.Tables.Append XTblInstalledSoftware

'=============================

'=============================

'tabel tblInstalledPrograms

XTblInstalledPrograms.Name = "TblInstalledPrograms"

XTblInstalledPrograms.Columns.Append "No", adInteger 'buat auto number

XTblInstalledPrograms.Columns.Append "Komputer", adVarWChar, 30

XTblInstalledPrograms.Columns.Append "AuditDate", adVarWChar, 30

XTblInstalledPrograms.Columns.Append "SWName", adVarWChar, 100

XTblInstalledPrograms.Columns.Append "Vendor", adVarWChar, 100

XTblInstalledPrograms.Columns.Append "Version", adVarWChar, 100

XTblInstalledPrograms.Columns.Append "ProductLanguage", adVarWChar, 100

XTblInstalledPrograms.Columns.Append "InstallDate", adVarWChar, 100

XTblInstalledPrograms.Columns.Append "InstallLocation", adVarWChar, 200

XTblInstalledPrograms.Columns.Append "InstallSource", adVarWChar, 200

XTblInstalledPrograms.Columns.Append "InstallState", adVarWChar, 100

XTblInstalledPrograms.Columns.Append "AssignmentType", adVarWChar, 100

XTblInstalledPrograms.Columns.Append "PackageCode", adVarWChar, 100

XTblInstalledPrograms.Columns.Append "PackageName", adVarWChar, 100

XTblInstalledPrograms.Columns.Append "LocalPackage", adVarWChar, 100

XTblInstalledPrograms.Columns.Append "ProductID", adVarWChar, 100

XTblInstalledPrograms.Columns.Append "RegisteredCompany", adVarWChar, 100

XTblInstalledPrograms.Columns.Append "RegisteredOwner", adVarWChar, 100

XTblInstalledPrograms.Columns.Append "TimesUsed", adVarWChar, 100

XTblInstalledPrograms.Columns.Append "LastUsed", adVarWChar, 100

XTblInstalledPrograms.Columns.Append "ExecutablePath", adVarWChar, 200

XTblInstalledPrograms.Columns.Append "ExecutableVersion", adVarWChar, 100

XTblInstalledPrograms.Columns.Append "ExecutableDescription", adVarWChar, 100

XTblInstalledPrograms.Columns.Append "SoftwareID", adVarWChar, 100

With XTblInstalledPrograms.Columns!No

Set .ParentCatalog = XDBAuditReport

.Properties("Autoincrement") = True 'AutoNumber.

End With

XDBAuditReport.Tables.Append XTblInstalledPrograms

'=============================

'=============================

'tabel tblOperatingSystem

XTblOperatingSystem.Name = "tblOperatingSystem"

XTblOperatingSystem.Columns.Append "No", adInteger 'buat auto number

XTblOperatingSystem.Columns.Append "Komputer", adVarWChar, 30

XTblOperatingSystem.Columns.Append "AuditDate", adVarWChar, 30

XTblOperatingSystem.Columns.Append "OSName", adVarWChar, 100

XTblOperatingSystem.Columns.Append "Edition", adVarWChar, 100

XTblOperatingSystem.Columns.Append "InstallDate", adVarWChar, 100

XTblOperatingSystem.Columns.Append "RegisteredOwner", adVarWChar, 100

XTblOperatingSystem.Columns.Append "RegisteredOrganization", adVarWChar, 100

XTblOperatingSystem.Columns.Append "ProductID", adVarWChar, 100

XTblOperatingSystem.Columns.Append "MajorVersionNumber", adVarWChar, 100

XTblOperatingSystem.Columns.Append "MinorVersionNumber", adVarWChar, 100

XTblOperatingSystem.Columns.Append "BuildNumber", adVarWChar, 100

XTblOperatingSystem.Columns.Append "ServicePack", adVarWChar, 100

XTblOperatingSystem.Columns.Append "ServicePackVersion", adVarWChar, 100

XTblOperatingSystem.Columns.Append "PlusVersionNumber", adVarWChar, 100

XTblOperatingSystem.Columns.Append "DirectXVersion", adVarWChar, 100

XTblOperatingSystem.Columns.Append "WindowsDirectory", adVarWChar, 100

XTblOperatingSystem.Columns.Append "SystemDirectory", adVarWChar, 100

XTblOperatingSystem.Columns.Append "TemporaryDirectory", adVarWChar, 100

With XTblOperatingSystem.Columns!No

Set .ParentCatalog = XDBAuditReport

.Properties("Autoincrement") = True 'AutoNumber.

End With

XDBAuditReport.Tables.Append XTblOperatingSystem

'=============================

Set XDBAuditReport = Nothing

End Sub

Sub BukaDB(Alamatnya As String)

Dim strKonek As String

strKonek = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Alamatnya & ";Persist Security Info=False"

If CnDBAuditReport.State = 0 Then

CnDBAuditReport.CursorLocation = adUseClient

CnDBAuditReport.Open strKonek

End If

RsInstalledSoftware.Open "tblInstalledSoftware", CnDBAuditReport, adOpenKeyset, adLockOptimistic

RsInstalledPrograms.Open "tblInstalledPrograms", CnDBAuditReport, adOpenKeyset, adLockOptimistic

RsOperatingSystem.Open "tblOperatingSystem", CnDBAuditReport, adOpenKeyset, adLockOptimistic

End Sub

'===============================

Langkah Kedua: Mengenali Pola Penanda File

Kok mengenali pola? Yup....mengenali pola file text hasil winaudit tersebut. Coba perhatikan beberapa baris awal file hasil winaudit berikut ini:

-------------

| ________ |

-------------

Computer Audit :: 5/20/2010 10:42:41 AM

Installed Software

Active Setup

-----------------------------------------------------------------------------

| Name | Version | Installed |

-----------------------------------------------------------------------------

| .NET Framework | 2,0,50727,0 | |

| Active Directory Service Interface | 5,0,00,0 | Yes |

...dst

Kalau kita perhatikan pada baris pertama sampai baris ketiga, terdapat beberapa karakter garis (- | _ ). Kalau dilihat di semua file hasil text winaudit pasti terdapat karakter tersebut. Karakter inilah yang saya gunakan untuk mengenali apakah file text tersebut adalah file hasil Winaudit.

Sehingga saya merasa perlu membuat function untuk mengecek (memeriksa) apakah file yang akan diproses adalah file hasil Winaudit. Berikut script seadanya:

'===================

Function CekFileAudit(filenya As String) As Boolean

Dim Textnya As String

Dim Hasilnya As String

Dim JmlGrsMin As Integer

Dim I As Integer

I = 1

Open filenya For Input As I

While Not EOF(I)

Line Input #I, Textnya

If I = 1 Then

If Trim(Left(Textnya, 15)) <> "-------------" Then CekFileAudit = False: Close I: Exit Function

ElseIf I = 2 Then

If Trim(Left(Textnya, 15)) <> "| ________ |" Then CekFileAudit = False: Close I: Exit Function

ElseIf I = 3 Then

If Trim(Left(Textnya, 15)) <> "-------------" Then CekFileAudit = False: Close I: Exit Function

End If

CekFileAudit = True

Close I

Exit Function

Wend

Close I

End Function

'===========================================================

Script tersebut akan memeriksa pada baris pertama sampai baris ketiga, apakah ada karakter yang menjadi ciri khas file hasil winaudit. Jika ada, maka function tersebut akan bernilai TRUE tetapi jika tidak ada, maka akan bernilai FALSE.

Langkah Ketiga: Mengenali Pola Untuk Pembacaan Data

Dengan mendeteksi karakter-karakter yang digunakan dalam file hasil winaudit tersebut (seperti pengenalan pola pada penanda file), berikut adalah script yang saya gunakan untuk membaca datanya:

'======================

'untuk mengambil data Installed Software

Sub BacaInsSoft(filenya As String, NamaKomp As String)

Dim Textnya As String

Dim Hasilnya As String

Dim JmlGrsMin As Integer

Dim TglAudit As String

Dim Mulai As Boolean

JmlGrsMin = 0

Dim I As Integer

I = 1

Open filenya For Input As I

While Not EOF(I)

langsung:

Line Input #I, Textnya

If Trim(Left(Textnya, 15)) = "Computer Audit" Then

TglAudit = Trim(Mid(Textnya, 19, Len(Textnya) - 17))

End If

If Trim(Textnya) = "Installed Software" Then

Mulai = True

GoTo langsung

End If

If Mulai = True Then

'pengecekan garis pembatas

If Trim(Left(Textnya, 15)) = "---------------" Then

JmlGrsMin = JmlGrsMin + 1

ElseIf JmlGrsMin = 3 Then

'sudah sampai batas akhir datanya

Close I

Exit Sub

ElseIf JmlGrsMin = 2 Then

'mulai pembacaan data disimpan ke database

Dim flName As String

Dim flVersion As String

Dim flInstalled As String

Dim Panjang As Integer

Panjang = Len(Textnya)

If Panjang = 0 Then GoTo langsung

flName = Mid(Textnya, 2, Panjang - 33)

flVersion = Mid(Textnya, Len(flName) + 4, 16)

flInstalled = Mid(Textnya, Len(flName) + Len(flVersion) + 5, 12)

'simpan ke database

'diasumsikan sudah ada pengecekan nama komputer yang sama

With RsInstalledSoftware

.AddNew

'field(0) auto increment

.Fields(1).Value = IIf(IsNull(Trim(NamaKomp)) = True, "", Trim(NamaKomp))

.Fields(2).Value = IIf(IsNull(Trim(TglAudit)) = True, "", Trim(TglAudit))

.Fields(3).Value = IIf(IsNull(Trim(flName)) = True, "", Trim(flName))

.Fields(4).Value = IIf(IsNull(Trim(flVersion)) = True, "", Trim(flVersion))

.Fields(5).Value = IIf(IsNull(Trim(flInstalled)) = True, "", Trim(flInstalled))

.Update

End With

'Hasilnya = Hasilnya & flName & "#" & flVersion & "#" & flInstalled & vbCrLf

End If

End If

Wend

Close I

End Sub

'==================

'untuk mengambil data Installed Programs

Sub BacaInsProgs(filenya As String, NamaKomp As String)

Dim Textnya As String

Dim Hasilnya As String

Dim JmlGrsMin As Integer

Dim TglAudit As String

Dim Mulai As Boolean

Dim Kolom As Integer

Dim flName As String

Dim flVendor As String

Dim flVersion As String

Dim flProductLanguage As String

Dim flInstallDate As String

Dim flInstallLocation As String

Dim flInstallSource As String

Dim flInstallState As String

Dim flAssignmentType As String

Dim flPackageCode As String

Dim flPackageName As String

Dim flLocalPackage As String

Dim flProductID As String

Dim flRegisteredCompany As String

Dim flRegisteredOwner As String

Dim flTimesUsed As String

Dim flLastUsed As String

Dim flExecutablePath As String

Dim flExecutableVersion As String

Dim flExecutableDescription As String

Dim flSoftwareID As String

JmlGrsMin = 0

Kolom = 1

Dim I As Integer

I = 1

Open filenya For Input As I

While Not EOF(I)

langsung:

Line Input #I, Textnya

If Trim(Left(Textnya, 15)) = "Computer Audit" Then

TglAudit = Trim(Mid(Textnya, 19, Len(Textnya) - 17))

End If

If Trim(Textnya) = "Installed Programs" Then

Mulai = True

GoTo langsung

End If

If Trim(Textnya) = "Software Updates" Then

Mulai = False

Close I

Exit Sub

End If

'sejak tanda pertama

If Mulai = True Then

'pengecekan garis pembatas

If Trim(Left(Textnya, 15)) = "---------------" Then

JmlGrsMin = JmlGrsMin + 1

ElseIf JmlGrsMin = 4 Then

'sudah sampai batas akhir datanya

'simpan ke database

'diasumsikan sudah ada pengecekan nama komputer yang sama

With RsInstalledPrograms

.AddNew

'field(0) auto increment

.Fields(1).Value = IIf(IsNull(Trim(NamaKomp)) = True, "", Trim(NamaKomp))

.Fields(2).Value = IIf(IsNull(Trim(TglAudit)) = True, "", Trim(TglAudit))

.Fields(3).Value = IIf(IsNull(Trim(flName)) = True, "", Trim(flName))

.Fields(4).Value = IIf(IsNull(Trim(flVendor)) = True, "", Trim(flVendor))

.Fields(5).Value = IIf(IsNull(Trim(flVersion)) = True, "", Trim(flVersion))

.Fields(6).Value = IIf(IsNull(Trim(flProductLanguage)) = True, "", Trim(flProductLanguage))

.Fields(7).Value = IIf(IsNull(Trim(flInstallDate)) = True, "", Trim(flInstallDate))

.Fields(8).Value = IIf(IsNull(Trim(flInstallLocation)) = True, "", Trim(flInstallLocation))

.Fields(9).Value = IIf(IsNull(Trim(flInstallSource)) = True, "", Trim(flInstallSource))

.Fields(10).Value = IIf(IsNull(Trim(flInstallState)) = True, "", Trim(flInstallState))

.Fields(11).Value = IIf(IsNull(Trim(flAssignmentType)) = True, "", Trim(flAssignmentType))

.Fields(12).Value = IIf(IsNull(Trim(flPackageCode)) = True, "", Trim(flPackageCode))

.Fields(13).Value = IIf(IsNull(Trim(flPackageName)) = True, "", Trim(flPackageName))

.Fields(14).Value = IIf(IsNull(Trim(flLocalPackage)) = True, "", Trim(flLocalPackage))

.Fields(15).Value = IIf(IsNull(Trim(flProductID)) = True, "", Trim(flProductID))

.Fields(16).Value = IIf(IsNull(Trim(flRegisteredCompany)) = True, "", Trim(flRegisteredCompany))

.Fields(17).Value = IIf(IsNull(Trim(flRegisteredOwner)) = True, "", Trim(flRegisteredOwner))

.Fields(18).Value = IIf(IsNull(Trim(flTimesUsed)) = True, "", Trim(flTimesUsed))

.Fields(19).Value = IIf(IsNull(Trim(flLastUsed)) = True, "", Trim(flLastUsed))

.Fields(20).Value = IIf(IsNull(Trim(flExecutablePath)) = True, "", Trim(flExecutablePath))

.Fields(21).Value = IIf(IsNull(Trim(flExecutableVersion)) = True, "", Trim(flExecutableVersion))

.Fields(22).Value = IIf(IsNull(Trim(flExecutableDescription)) = True, "", Trim(flExecutableDescription))

.Fields(23).Value = IIf(IsNull(Trim(flSoftwareID)) = True, "", Trim(flSoftwareID))

.Update

End With

'reset jmlgrsmin

JmlGrsMin = 0

ElseIf JmlGrsMin = 2 Then

'mulai pembacaan data

Dim Panjang As Integer

Panjang = Len(Textnya)

If Panjang = 0 Then GoTo langsung

If Kolom = 1 Then

flName = Trim(Mid(Textnya, 28, Panjang - 28))

Kolom = Kolom + 1

'Hasilnya = Hasilnya & flName & "#"

ElseIf Kolom = 2 Then

flVendor = Trim(Mid(Textnya, 28, Panjang - 28))

Kolom = Kolom + 1

'Hasilnya = Hasilnya & flVendor & "#"

ElseIf Kolom = 3 Then

flVersion = Trim(Mid(Textnya, 28, Panjang - 28))

Kolom = Kolom + 1

'Hasilnya = Hasilnya & flVersion & "#"

ElseIf Kolom = 4 Then

flProductLanguage = Trim(Mid(Textnya, 28, Panjang - 28))

Kolom = Kolom + 1

'Hasilnya = Hasilnya & flProductLanguage & "#"

ElseIf Kolom = 5 Then

flInstallDate = Trim(Mid(Textnya, 28, Panjang - 28))

Kolom = Kolom + 1

'Hasilnya = Hasilnya & flInstallDate & "#"

ElseIf Kolom = 6 Then

flInstallLocation = Trim(Mid(Textnya, 28, Panjang - 28))

Kolom = Kolom + 1

'Hasilnya = Hasilnya & flInstallLocation & "#"

ElseIf Kolom = 7 Then

flInstallSource = Trim(Mid(Textnya, 28, Panjang - 28))

Kolom = Kolom + 1

'Hasilnya = Hasilnya & flInstallSource & "#"

ElseIf Kolom = 8 Then

flInstallState = Trim(Mid(Textnya, 28, Panjang - 28))

Kolom = Kolom + 1

'Hasilnya = Hasilnya & flInstallState & "#"

ElseIf Kolom = 9 Then

flAssignmentType = Trim(Mid(Textnya, 28, Panjang - 28))

Kolom = Kolom + 1

'Hasilnya = Hasilnya & flAssignmentType & "#"

ElseIf Kolom = 10 Then

flPackageCode = Trim(Mid(Textnya, 28, Panjang - 28))

Kolom = Kolom + 1

'Hasilnya = Hasilnya & flPackageCode & "#"

ElseIf Kolom = 11 Then

flPackageName = Trim(Mid(Textnya, 28, Panjang - 28))

Kolom = Kolom + 1

'Hasilnya = Hasilnya & flPackageName & "#"

ElseIf Kolom = 12 Then

flLocalPackage = Trim(Mid(Textnya, 28, Panjang - 28))

Kolom = Kolom + 1

'Hasilnya = Hasilnya & flLocalPackage & "#"

ElseIf Kolom = 13 Then

flProductID = Trim(Mid(Textnya, 28, Panjang - 28))

Kolom = Kolom + 1

'Hasilnya = Hasilnya & flProductID & "#"

ElseIf Kolom = 14 Then

flRegisteredCompany = Trim(Mid(Textnya, 28, Panjang - 28))

Kolom = Kolom + 1

'Hasilnya = Hasilnya & flRegisteredCompany & "#"

ElseIf Kolom = 15 Then

flRegisteredOwner = Trim(Mid(Textnya, 28, Panjang - 28))

Kolom = Kolom + 1

'Hasilnya = Hasilnya & flRegisteredOwner & "#"

ElseIf Kolom = 16 Then

flTimesUsed = Trim(Mid(Textnya, 28, Panjang - 28))

Kolom = Kolom + 1

'Hasilnya = Hasilnya & flTimesUsed & "#"

ElseIf Kolom = 17 Then

flLastUsed = Trim(Mid(Textnya, 28, Panjang - 28))

Kolom = Kolom + 1

'Hasilnya = Hasilnya & flLastUsed & "#"

ElseIf Kolom = 18 Then

flExecutablePath = Trim(Mid(Textnya, 28, Panjang - 28))

Kolom = Kolom + 1

'Hasilnya = Hasilnya & flExecutablePath & "#"

ElseIf Kolom = 19 Then

flExecutableVersion = Trim(Mid(Textnya, 28, Panjang - 28))

Kolom = Kolom + 1

'Hasilnya = Hasilnya & flExecutableVersion & "#"

ElseIf Kolom = 20 Then

flExecutableDescription = Trim(Mid(Textnya, 28, Panjang - 28))

Kolom = Kolom + 1

'Hasilnya = Hasilnya & flExecutableDescription & "#"

ElseIf Kolom = 21 Then

flSoftwareID = Trim(Mid(Textnya, 28, Panjang - 28))

'selesai pembacaan data

Kolom = 1

'Mulai = False

'Hasilnya = Hasilnya & flSoftwareID & vbCrLf

End If

End If

End If

Wend

Close I

Exit Sub

End Sub

'untuk mengambil data Operating System

Sub BacaOprSys(filenya As String, NamaKomp As String)

Dim Textnya As String

Dim Hasilnya As String

Dim JmlGrsMin As Integer

Dim TglAudit As String

Dim Mulai As Boolean

Dim Kolom As Integer

'======================

Dim flName As String '1

Dim flEdition As String '2

Dim flInstallDate As String '3

Dim flRegisteredOwner As String '4

Dim flRegisteredOrganization As String '5

Dim flProductID As String '6

Dim flMajorVersionNumber As String '7

Dim flMinorVersionNumber As String '8

Dim flBuildNumber As String '9

Dim flServicePack As String '10

Dim flServicePackVersion As String '11

Dim flPlusVersionNumber As String '12

Dim flDirectXVersion As String '13

Dim flWindowsDirectory As String '14

Dim flSystemDirectory As String '15

Dim flTemporaryDirectory As String '16

JmlGrsMin = 0

Kolom = 1

Dim I As Integer

I = 1

Open filenya For Input As I

While Not EOF(I)

langsung:

Line Input #I, Textnya

If Trim(Left(Textnya, 15)) = "Computer Audit" Then

TglAudit = Trim(Mid(Textnya, 19, Len(Textnya) - 17))

End If

If Trim(Textnya) = "Operating System" Then

Mulai = True

GoTo langsung

End If

'sejak tanda pertama

If Mulai = True Then

'pengecekan garis pembatas

If Trim(Left(Textnya, 15)) = "---------------" Then

JmlGrsMin = JmlGrsMin + 1

ElseIf JmlGrsMin = 3 Then

'sudah sampai batas akhir datanya

'simpan ke database

'diasumsikan sudah ada pengecekan nama komputer yang sama

With RsOperatingSystem

.AddNew

'field(0) auto increment

.Fields(1).Value = IIf(IsNull(Trim(NamaKomp)) = True, "", Trim(NamaKomp))

.Fields(2).Value = IIf(IsNull(Trim(TglAudit)) = True, "", Trim(TglAudit))

'===

.Fields(3).Value = IIf(IsNull(Trim(flName)) = True, "", Trim(flName))

.Fields(4).Value = IIf(IsNull(Trim(flEdition)) = True, "", Trim(flEdition))

.Fields(5).Value = IIf(IsNull(Trim(flInstallDate)) = True, "", Trim(flInstallDate))

.Fields(6).Value = IIf(IsNull(Trim(flRegisteredOwner)) = True, "", Trim(flRegisteredOwner))

.Fields(7).Value = IIf(IsNull(Trim(flRegisteredOrganization)) = True, "", Trim(flRegisteredOrganization))

.Fields(8).Value = IIf(IsNull(Trim(flProductID)) = True, "", Trim(flProductID))

.Fields(9).Value = IIf(IsNull(Trim(flMajorVersionNumber)) = True, "", Trim(flMajorVersionNumber))

.Fields(10).Value = IIf(IsNull(Trim(flMinorVersionNumber)) = True, "", Trim(flMinorVersionNumber))

.Fields(11).Value = IIf(IsNull(Trim(flBuildNumber)) = True, "", Trim(flBuildNumber))

.Fields(12).Value = IIf(IsNull(Trim(flServicePack)) = True, "", Trim(flServicePack))

.Fields(13).Value = IIf(IsNull(Trim(flServicePackVersion)) = True, "", Trim(flServicePackVersion))

.Fields(14).Value = IIf(IsNull(Trim(flPlusVersionNumber)) = True, "", Trim(flPlusVersionNumber))

.Fields(15).Value = IIf(IsNull(Trim(flDirectXVersion)) = True, "", Trim(flDirectXVersion))

.Fields(16).Value = IIf(IsNull(Trim(flWindowsDirectory)) = True, "", Trim(flWindowsDhrectory))

.Fields(17).Value = IIf(IsNull(Trim(flSystemDirectory)) = True, "", Trim(flSystemDirectory))

.Fields(18).Value = IIf(IsNull(Trim(flTemporaryDirectory)) = True, "", Trim(flTemporaryDirectory))

.Update

End With

'tutup perulangan

'selesai

Close I

Exit Sub

ElseIf JmlGrsMin = 2 Then

'mulai pembacaan data

Dim Panjang As Integer

Panjang = Len(Textnya)

If Panjang = 0 Then GoTo langsung

If Kolom = 1 Then

flName = Trim(Mid(Textnya, 29, Panjang - 29))

Kolom = Kolom + 1

'Hasilnya = Hasilnya & flName & "#"

ElseIf Kolom = 2 Then

flEdition = Trim(Mid(Textnya, 29, Panjang - 29))

Kolom = Kolom + 1

'Hasilnya = Hasilnya & flVendor & "#"

ElseIf Kolom = 3 Then

flInstallDate = Trim(Mid(Textnya, 29, Panjang - 29))

Kolom = Kolom + 1

'Hasilnya = Hasilnya & flVersion & "#"

ElseIf Kolom = 4 Then

flRegisteredOwner = Trim(Mid(Textnya, 29, Panjang - 29))

Kolom = Kolom + 1

'Hasilnya = Hasilnya & flProductLanguage & "#"

ElseIf Kolom = 5 Then

flRegisteredOrganization = Trim(Mid(Textnya, 29, Panjang - 29))

Kolom = Kolom + 1

'Hasilnya = Hasilnya & flInstallDate & "#"

ElseIf Kolom = 6 Then

flProductID = Trim(Mid(Textnya, 29, Panjang - 29))

Kolom = Kolom + 1

'Hasilnya = Hasilnya & flInstallLocation & "#"

ElseIf Kolom = 7 Then

flMajorVersionNumber = Trim(Mid(Textnya, 29, Panjang - 29))

Kolom = Kolom + 1

'Hasilnya = Hasilnya & flInstallSource & "#"

ElseIf Kolom = 8 Then

flMinorVersionNumber = Trim(Mid(Textnya, 29, Panjang - 29))

Kolom = Kolom + 1

'Hasilnya = Hasilnya & flInstallState & "#"

ElseIf Kolom = 9 Then

flBuildNumber = Trim(Mid(Textnya, 29, Panjang - 29))

Kolom = Kolom + 1

'Hasilnya = Hasilnya & flAssignmentType & "#"

ElseIf Kolom = 10 Then

flServicePack = Trim(Mid(Textnya, 29, Panjang - 29))

Kolom = Kolom + 1

'Hasilnya = Hasilnya & flPackageCode & "#"

ElseIf Kolom = 11 Then

flServicePackVersion = Trim(Mid(Textnya, 29, Panjang - 29))

Kolom = Kolom + 1

'Hasilnya = Hasilnya & flPackageName & "#"

ElseIf Kolom = 12 Then

flPlusVersionNumber = Trim(Mid(Textnya, 29, Panjang - 29))

Kolom = Kolom + 1

'Hasilnya = Hasilnya & flLocalPackage & "#"

ElseIf Kolom = 13 Then

flDirectXVersion = Trim(Mid(Textnya, 29, Panjang - 29))

Kolom = Kolom + 1

'Hasilnya = Hasilnya & flProductID & "#"

ElseIf Kolom = 14 Then

flWindowsDirectory = Trim(Mid(Textnya, 29, Panjang - 29))

Kolom = Kolom + 1

'Hasilnya = Hasilnya & flRegisteredCompany & "#"

ElseIf Kolom = 15 Then

flSystemDirectory = Trim(Mid(Textnya, 29, Panjang - 29))

Kolom = Kolom + 1

'Hasilnya = Hasilnya & flRegisteredOwner & "#"

ElseIf Kolom = 16 Then

flTemporaryDirectory = Trim(Mid(Textnya, 29, Panjang - 29))

Kolom = Kolom + 1

'selesai

Kolom = 1

'Mulai = False

'Hasilnya = Hasilnya & flSoftwareID & vbCrLf

End If

End If

End If

Wend

Close I

Exit Sub

End Sub

'=====================

Kalau kita perhatikan dengan seksama, script yang saya buat tersebut menggunakan pengenalan pola dengan cara sederhana yaitu memeriksa satu-persatu tiap baris dari file hasil winaudit (karena keterbatasan kemampuan saya tentunya).

Langkah Berikutnya: Lengkapi Programnya.

Lengkapi program? maksudnya program di atas tadi cuma intinya saja...untuk kelengkapan mulai dari komponen/reference yang digunakan dan script-script yang lain bisa ditambahkan sendiri sesuai dengan algoritma dan logika pemrograman masing-masing.

Semoga bermanfaat. Insya Alloh...! Amiin...!

(Akr)

Cara Import atau Memindah Data dari Sheet di File Microsoft Excel Menjadi Tabel di File Microsoft Access Menggunakan ADO Microsoft Visual Basic 6.0

Pada posting sebelumnya sudah saya sebutkan contoh cara membuka file Excel di Microsoft Visual Basic 6. menggunakan ADO. Karena file Excel memang bukan "real" database, sehingga biasanya file Excel tidak dijadikan database utama dalam suatu program. Karena Microsoft Excel sudah menjadi aplikasi yang sudah umum digunakan, sehingga biasanya data-data kebanyakan disimpan ke dalam File Excel. Begitu juga dengan data-data yang dibutuhkan dalam sebuah program yang kita buat seringkali user meminta kita untuk memindahkkan data yang sudah ada dari file Excel ke dalam program yang kita buat karena user tentunya tidak mau repot untuk mengetik ulang dan menginputkan semua datanya ke dalam program kita.

Karena latar belakang itulah, perlu kita buatkan ataun tambahkan fasilitas untuk mengambil data dari file Microsoft Excel ke database yang digunakan oleh program kita. Sebagai contoh, database yang digunakan oleh program kita adalah Microsoft Access.

Kali ini akan saya berikan contoh untuk mengambil data dari File Excel menjadi tabel di File Microsoft Access menggunakan ADO.

Sub ImportExcel(Dlg As CommonDialog)

   'variabel untuk koneksi database
   Dim Koneksi As New ADODB.Connection
   Dim rsExcel As New ADODB.Recordset
   Dim strAlamat As String
   Dim strKonek As String


   Dlg.ShowOpen


   If Dlg.FileName = "" Then Exit Sub


On Error Resume Next
   strAlamat = Dlg.FileName
   strKonek = "Provider=Microsoft.jet.OLEDB.4.0;"
   strKonek = strKonek & "data source="
   strKonek = strKonek & App.Path & "\Dataku.mdb" & ";"


'Lakukan koneksi ke file database/excel
   Koneksi.CursorLocation = adUseClient
   Koneksi.Open strKonek


'buka tabel/sheet
   strKueri = "SELECT * INTO tblIdentitas FROM " &
   strKueri = "[Excel 8.0;Database=" & strAlamat & "].[Sheet1$]"


   rsExcel.Open strKueri, Koneksi, adOpenKeyset, adLockOptimistic
   If Err.Number <> 0 Then
      MsgBox Err.Description, vbOKOnly + vbInformation, "informasi"
      Exit Sub
   end if


   MsgBox "Import Data selesai"
   rsExcel.Close
   Set rsExcel = Nothing
   Koneksi.Close
   Set Koneksi = Nothing
End Sub

Script di atas akan mengambil data dari Sheet1 di file Excel menjadi tabel "tblIdentitas" di File "dataku.mdb". Agar script tersebut berjalan dengan baik, file Dataku.mdb sudah harus terbentuk dan tblIdentitas masih belum ada dalam database Dataku.mdb.

Selamat Mencoba

Cara Membuka File Excel Menggunakan ADO pada Microsoft Visual Basic 6.0

Meskipun Excel tidak ditujukan menjadi database dalam pemrograman Visual Basic 6.0 tetapi kita bisa membuka file Excel tersebut menggunakan Microsoft Visual Basic 6.0 menggunakan ADO.

Kenapa Menggunakan ADO?
Koneksi ke file Excel lebih baik menggunakan ADO karena meskipun di komputer atau PC tersebut tidak terinstall Microsoft Office, kita masih bisa menggunakan ADO untuk membuka file Excel tersebut.

Bagaimana Cara Membuka File Excel Menggunakan ADO?
Caranya cukup mudah, dan mirip dengan cara membuka file database lainnya semisal Access (mdb). Perbedaannya cuma ada beberapa tambahan pada Connection String-nya.

Misalkan kita punya file Excel dengan nama"Dataku.xls" yang berisi Sheet1, Sheet2, Sheet3.
Pastikan di MS VB6-nya sudah kita aktifkan Referensi Micsosoft ActiveX Data Object 2.0 Library.
Pada awal script kita definiskan dahulu variabelnya seperti berikut:
'==================

Option Explicit

'variabel untuk koneksi ke file excel
Public Conn As New ADODB.Connection

'variabel untuk koneksi ke tabel/sheet
Public rsIdentitas As New ADODB.Recordset

'==================

Kemudian kita buat Sub baru berisi prosedur untuk mengkoneksikan file Excel seperti contoh berikut:

Sub BukaExcel()
    Dim strAlamat As String
    Dim strKonek As String
   
    strAlamat = App.Path & "\dataku.xls"
    strKonek = "Provider=Microsoft.jet.OLEDB.4.0;"
    strKonek = strKonek & "data source=" & strAlamat & ";"
    strKonek = strKonek & "Extended Properties='Excel 8.0;HDR=Yes;IMEX=0';"

'Lakukan koneksi ke file database/excel
    Conn.CursorLocation = adUseClient
    Conn.Open strKonek
   
'buka tabel/sheet
    Dim strKueri As String
    strKueri = "Select * from [Sheet1$]"
    rsIdentitas.Open strKueri, Conn, adOpenKeyset, adLockOptimistic
End Sub

Pada saat form Load, kita panggil sub yang kita buat tersebut seperti contoh berikut:

Private Sub Form_Load()
    BukaExcel
End Sub

Selanjutnya, bisa kita olah data tersebut seperti pengolahan database pada umumnya. Tapi ingat, Excel bukan untuk database sehingga ada keterbatasan pada pengolahan file Excel misalnya: tidak bisa dilakukan perintah recordset.delete (menghapus record) sehingga harus disiasati menggunakan cara lain.