Misalkan ada tabel excel yang datanya seperti gambar dibawah ini
Dan data-data diatas akan di import ke tabel yang ada di database access tapi dengan menggunakan interface Visual Basic, perhatikan contoh yang saya buat dibawah ini
Designlah form nya seperti gambar dibawah ini
Designlah form nya seperti gambar dibawah ini
Pada saat dijlankan, apabila commandbutton Cari File Excel diklik akan terbuka seperti gambar dibawah ini
Dan selanjutnya semua data yg ada pada tabel di excel akan ditampung dalam datagrid
Lalu setelah di pilih commandbutton Import to Access maka semua data yg tampil pada datagrid akan di import ke tabel access, dan hasilnya responya setalah tombol ini dipilih seperti gambar dibawah ini :
Berikut ini, adalah kode-kode yang diperlukan utk proses diatas
'---koneksi utk access
Dim conn As New Connection
'---koneksi utk excel
Dim connXls As New Connection
'---recordset utk menampung data excel
Dim rsXls As New Recordset
'---recordset utk mengimport data excel
'---yg ditampung oleh recordset rsXls
Dim rsImport As New Recordset
'---recordset yg menerima/menyimpan data excel
Dim rsSaveToDatabase As New Recordset
Private Sub Form_Load()
conn.Provider = "Microsoft.Jet.OleDB.4.0"
conn.Open App.Path & "\Northwind.mdb"
rsSaveToDatabase.CursorLocation = adUseClient
rsSaveToDatabase.Open "Customers", conn, adOpenDynamic, adLockOptimistic
End Sub
Private Sub cmdCariFileExcel_Click()
Dim FileExcel As String
'---cari file excel dgn commondialog---'
CommonDialog1.DialogTitle = "Excel File"
CommonDialog1.Filter = "Excel (*.xls)|*.xls"
CommonDialog1.InitDir = App.Path
CommonDialog1.ShowOpen
FileExcel = CommonDialog1.FileName
'---kalo tombol cancel dipilih keluar prosedur
If FileExcel = "" Then Exit Sub
'---buka file excel kedalam recordset---'
connXls.Open "Provider=Microsoft.Jet.OleDB.4.0;" & _
"Data Source=" & FileExcel & ";" & _
" Extended Properties=Excel 8.0;"
rsXls.CursorLocation = adUseClient
rsXls.Open "SELECT * FROM [Customers]", connXls
'---hitung jumlah semua field yg ada
kolom = rsXls.Fields.Count - 1
'---recordset buatan utk menampung data excel
For i = 0 To kolom
rsImport.Fields.Append rsXls.Fields(i).Name, adVarChar, 255
Next
rsImport.CursorLocation = adUseClient
Set rsImport = rsXls.Clone
'---tampilkan data excel ke datagrid melalui recordset buatan
Set DataGrid1.DataSource = rsImport
End Sub
Private Sub cmdImportToAccess_Click()
rsImport.MoveFirst
'---hitung jumlah baris/data yg ada pd recordset buatan
Row = rsImport.RecordCount - 1
'---hitung jumlah semua field yg ada
kolom = rsImport.Fields.Count - 1
'---masukkan satu persatu data yg ada pd recodset buatan
'---ke tabel database access
For j = 0 To Row
rsSaveToDatabase.AddNew
For k = 0 To kolom
rsSaveToDatabase(k) = rsImport(k)
Next
rsSaveToDatabase.Update
rsImport.MoveNext
Next
MsgBox "Ada " & rsSaveToDatabase.RecordCount & " data yang di import"
End Sub
'---koneksi utk access
Dim conn As New Connection
'---koneksi utk excel
Dim connXls As New Connection
'---recordset utk menampung data excel
Dim rsXls As New Recordset
'---recordset utk mengimport data excel
'---yg ditampung oleh recordset rsXls
Dim rsImport As New Recordset
'---recordset yg menerima/menyimpan data excel
Dim rsSaveToDatabase As New Recordset
Private Sub Form_Load()
conn.Provider = "Microsoft.Jet.OleDB.4.0"
conn.Open App.Path & "\Northwind.mdb"
rsSaveToDatabase.CursorLocation = adUseClient
rsSaveToDatabase.Open "Customers", conn, adOpenDynamic, adLockOptimistic
End Sub
Private Sub cmdCariFileExcel_Click()
Dim FileExcel As String
'---cari file excel dgn commondialog---'
CommonDialog1.DialogTitle = "Excel File"
CommonDialog1.Filter = "Excel (*.xls)|*.xls"
CommonDialog1.InitDir = App.Path
CommonDialog1.ShowOpen
FileExcel = CommonDialog1.FileName
'---kalo tombol cancel dipilih keluar prosedur
If FileExcel = "" Then Exit Sub
'---buka file excel kedalam recordset---'
connXls.Open "Provider=Microsoft.Jet.OleDB.4.0;" & _
"Data Source=" & FileExcel & ";" & _
" Extended Properties=Excel 8.0;"
rsXls.CursorLocation = adUseClient
rsXls.Open "SELECT * FROM [Customers]", connXls
'---hitung jumlah semua field yg ada
kolom = rsXls.Fields.Count - 1
'---recordset buatan utk menampung data excel
For i = 0 To kolom
rsImport.Fields.Append rsXls.Fields(i).Name, adVarChar, 255
Next
rsImport.CursorLocation = adUseClient
Set rsImport = rsXls.Clone
'---tampilkan data excel ke datagrid melalui recordset buatan
Set DataGrid1.DataSource = rsImport
End Sub
Private Sub cmdImportToAccess_Click()
rsImport.MoveFirst
'---hitung jumlah baris/data yg ada pd recordset buatan
Row = rsImport.RecordCount - 1
'---hitung jumlah semua field yg ada
kolom = rsImport.Fields.Count - 1
'---masukkan satu persatu data yg ada pd recodset buatan
'---ke tabel database access
For j = 0 To Row
rsSaveToDatabase.AddNew
For k = 0 To kolom
rsSaveToDatabase(k) = rsImport(k)
Next
rsSaveToDatabase.Update
rsImport.MoveNext
Next
MsgBox "Ada " & rsSaveToDatabase.RecordCount & " data yang di import"
End Sub
No comments:
Post a Comment