Import Data Dari Excel Ke MS-Access 2003 Menggunakan VB6 dan ADODB
Beberapa aturan agar file excel bisa dibuka dengan ADODB adalah :
- Baris paling atas adalah menunjukkan nama field, jadi sebisa mungkin tidak ada baris kosong di baris paling atas (belum pernah saya coba)
- Usahakan agar kolom di paling atas diisi dengan nilai tanpa spasi karena ini menunjukkan nama field
- Nama table adalah sheet di excel diakhiri dengan tanda “$”, jadi jika anda ingin membuka sheet1 dengan SQL, maka statement yang digunakan adalah : “SELECT * FROM [sheet1$]“
- Buka koneksi ke excel dengan adodb
- Buka recordset excel dengan adodb
- Buka koneksi ke database Access dengan adodb
- Buka recordset Access dengan adodb
- Lakukan looping recordset excel
- Selama belum End-Of-File, lakukan penambahan record di recordset Access
- Selesai
Dim conn_xls As New ADODB.Connection
Dim rs_xls As New ADODB.Recordset
Dim jml_rec As Integer Dim conn_mdb As New ADODB.Connection
Dim rs_mdb As New ADODB.Recordset
Dim rs_harga As New ADODB.Recordset
‘koneksi xls
conn_xls.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & App.Path & "\import\master.xls" & _
";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"""
conn_xls.Open
‘rs xls
rs_xls.Open "SELECT COUNT(*) AS jml_rec FROM [sheet1$]", conn_xls
jml_rec = rs_xls!jml_rec
rs_xls.Close
rs_xls.Open "SELECT * FROM [sheet1$]", conn_xls
‘koneksi mdb
conn_mdb.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & App.Path & "\store.mdb;" & _
"Jet OLEDB:Database Password=password"
conn_mdb.Open
‘rs mdb
rs_mdb.Open "master", conn_mdb, _
adOpenKeyset, adLockPessimistic, adCmdTableDirect
rs_harga.Open "harga", conn_mdb, _
adOpenKeyset, adLockOptimistic, adCmdTableDirect
Dim i As Integer
Dim sCaption As String
sCaption = Caption
Caption = "Please Wait…"
Screen.MousePointer = vbHourglass
cmdImportMst.Visible = False
Me.Refresh
prgBar.Visible = True
prgBar.Max = jml_rec
While Not rs_xls.EOF
rs_mdb.AddNew
rs_mdb!plu = rs_xls!plu
rs_mdb!barcode = rs_xls!barcode
rs_mdb!descp = rs_xls!descp
rs_mdb!sdescp = rs_xls!descp
rs_mdb!conv1 = 1
rs_mdb!conv2 = 1
rs_mdb!onhand = 0
rs_mdb!satuan = "PCS"
rs_mdb!stokmax = rs_xls!stokmax
rs_mdb!stokmin = rs_xls!stokmin
rs_mdb.Update
rs_harga.AddNew
rs_harga!plu = rs_xls!plu
rs_harga!hrgbeli2 = rs_xls!harga_beli
rs_harga!hrgjual2 = rs_xls!harga_jual
rs_harga!isi2 = 1
rs_harga!hrgjual1 = 0
rs_harga!isi1 = 1
rs_harga!tglubah = Date
rs_harga!kodeuser = 0
rs_harga.Update
i = i + 1
prgBar.Value = i
rs_xls.MoveNext
Wend
rs_mdb.Close
rs_harga.Close
rs_xls.Close
conn_xls.Close
conn_mdb.Close
Caption = sCaption
Screen.MousePointer = vbDefault
prgBar.Visible = False
cmdImportMst.Visible = True
MsgBox "Import Selesai.", vbExclamation, "Information"
Dim rs_xls As New ADODB.Recordset
Dim jml_rec As Integer Dim conn_mdb As New ADODB.Connection
Dim rs_mdb As New ADODB.Recordset
Dim rs_harga As New ADODB.Recordset
‘koneksi xls
conn_xls.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & App.Path & "\import\master.xls" & _
";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"""
conn_xls.Open
‘rs xls
rs_xls.Open "SELECT COUNT(*) AS jml_rec FROM [sheet1$]", conn_xls
jml_rec = rs_xls!jml_rec
rs_xls.Close
rs_xls.Open "SELECT * FROM [sheet1$]", conn_xls
‘koneksi mdb
conn_mdb.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & App.Path & "\store.mdb;" & _
"Jet OLEDB:Database Password=password"
conn_mdb.Open
‘rs mdb
rs_mdb.Open "master", conn_mdb, _
adOpenKeyset, adLockPessimistic, adCmdTableDirect
rs_harga.Open "harga", conn_mdb, _
adOpenKeyset, adLockOptimistic, adCmdTableDirect
Dim i As Integer
Dim sCaption As String
sCaption = Caption
Caption = "Please Wait…"
Screen.MousePointer = vbHourglass
cmdImportMst.Visible = False
Me.Refresh
prgBar.Visible = True
prgBar.Max = jml_rec
While Not rs_xls.EOF
rs_mdb.AddNew
rs_mdb!plu = rs_xls!plu
rs_mdb!barcode = rs_xls!barcode
rs_mdb!descp = rs_xls!descp
rs_mdb!sdescp = rs_xls!descp
rs_mdb!conv1 = 1
rs_mdb!conv2 = 1
rs_mdb!onhand = 0
rs_mdb!satuan = "PCS"
rs_mdb!stokmax = rs_xls!stokmax
rs_mdb!stokmin = rs_xls!stokmin
rs_mdb.Update
rs_harga.AddNew
rs_harga!plu = rs_xls!plu
rs_harga!hrgbeli2 = rs_xls!harga_beli
rs_harga!hrgjual2 = rs_xls!harga_jual
rs_harga!isi2 = 1
rs_harga!hrgjual1 = 0
rs_harga!isi1 = 1
rs_harga!tglubah = Date
rs_harga!kodeuser = 0
rs_harga.Update
i = i + 1
prgBar.Value = i
rs_xls.MoveNext
Wend
rs_mdb.Close
rs_harga.Close
rs_xls.Close
conn_xls.Close
conn_mdb.Close
Caption = sCaption
Screen.MousePointer = vbDefault
prgBar.Visible = False
cmdImportMst.Visible = True
MsgBox "Import Selesai.", vbExclamation, "Information"