Coding Import data dari Excel ke Database Ms. Acces Menggunakan VB 6.0

Postingan kali ini merupakan pengalaman pribadi saya. Di tempat kerja saya, saya mendapatkan tugas untuk membuat sebuah program penilaian untuk marketing. Salah satu proses dalam program yang saya buat adalah ada penilaian untuk absensi dan gaji. Untuk data sumber absensi sebenarnya sudah ada sistem berbasis web yang manangani hal tersebut, dimana datanya bisa di export dalam bentuk file excel. Agar tidak dua kali kerja si bos meminta agar file absensi dan gaji tersebut tidak perlu diinput lagi satu persatu ke dalam program yang saya buat, melainkan langsung diimport dari file excel yang diperoleh dari proses export tadi. Melaui bantuan mbah google, dan bertanya di forum-forum akhrinya saya menumukan caranya. Alur kerjanya saya buat sebagai berikut :
1. Persiapkan data Excelnya.
2. Import ke program yang sudah dibuat.
3. Simpan kedatabase.

Langkah pertama siapkan data excelnya. Selanjutnya desain tampilan form prgramnya. Adapun tampilan form yang saya buat adalah sebagai berikut:

  

Komponen yang saya gunakan

1. Listview (Listview1)

2. Command (cmdSimpan, dan Comand1)

1. CommonDialog (commondialog1)

Selanjutnya tambahkan coding berikut:

Private gy_Connection As ADODB.Connection

'Tombol simpan/Coding simpan

Private Sub cmdSimpan_Click()

Dim i As Integer

   Set gy_Connection = New ADODB.Connection

    gy_Connection.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\dbSales.mdb;"

   
    'On Error Resume Next

    Dim t As ListItem

    Dim r As ADODB.Recordset

   
    'Save

    If ListView1.ListItems.Count > 0 Then

        Set r = New ADODB.Recordset

        r.Open "select * from tbAbsen", gy_Connection, adOpenKeyset, adLockOptimistic

        If Not (r Is Nothing) Then

            If r.State > 0 Then

                For i = 1 To ListView1.ListItems.Count

                    Set t = ListView1.ListItems(i)
                    If Len(t.Text) > 0 Then

                        r.AddNew

                        r.Fields("id_absen").Value = t.Text

                        r.Fields("periode").Value = t.SubItems(1)

                        r.Fields("id_sales").Value = t.SubItems(2)

                        r.Fields("sakit").Value = t.SubItems(4)

                        r.Fields("ijin").Value = t.SubItems(5)

                        r.Fields("alpa").Value = t.SubItems(6)

                        r.Fields("ratio").Value = t.SubItems(7))

                       r.Update

                    End If

                    Set t = Nothing

                Next

                r.Close

            End If
            Set r = Nothing

        End If

    End If

   isi = MsgBox("Data Sudah Tersimpan!!", vbInformation, "Berhasil menyimpan")

   cmdSimpan.Enabled = False

   

   'mengosongkan listview

   Me.ListView1.ListItems.Clear

    Exit Sub



End Sub

'UNTUK TOMBOL IMPORT

Private Sub Command1_Click()

isi = MsgBox("Pastikan data Excelnya sudah benar!!", vbInformation, "Konfirmasi")

    Me.CommonDialog1.DialogTitle = "Buka File"

    Me.CommonDialog1.Filter = "Microsoft Excel 2007 Worksheet (*.xlsx)|*.xlsx|Microsoft Excel 1997-2003 Worksheet (*.xls)|*.xls"

    Me.CommonDialog1.ShowOpen

    If Me.CommonDialog1.FileName <> "" Then

        eksport

    End If

    Me.CommonDialog1.FileName = ""

    cmdSimpan.Enabled = True

End Sub

'Coding Impport

Sub eksport()

    Dim l As ListItem

    Dim exc As Excel.Application

    Dim wbk As Excel.Workbook

    Dim sht As Excel.Worksheet

    Set exc = Excel.Application

    Set wbk = Excel.Workbooks.Open(Me.CommonDialog1.FileName)

    Set sht = wbk.Sheets(1)  'angka 1 ini maksdunya adalah sheet yang di ambil. untuk hal ini adalah sheet1

    Me.ListView1.ListItems.Clear

    Me.ListView1.ColumnHeaders.Clear

    baris = 1

    kolom = 1

    While sht.Cells(1, kolom) <> ""

        Me.ListView1.ColumnHeaders.Add , , sht.Cells(1, kolom)

        kolom = kolom + 1

        kolommax = kolom - 1

    Wend

    While sht.Cells(baris, 1) <> ""

        If baris > 1 Then

            Set l = Me.ListView1.ListItems.Add(, , sht.Cells(baris, 1))

            kolom = 2

            For i = kolom To kolommax

                l.SubItems(i - 1) = sht.Cells(baris, i)

            Next i

        End If

        baris = baris + 1

        barismax = baris

    Wend

    kolom = 1

    baris = 1

    

    wbk.Close

    exc.Quit

End Sub

Silahkan di coba, Semoga bisa membantu.

Artikel Terkait