Cara Export Data dari Database Acces ke Excel 2007 Dengan VB6

Pada postingan sebelumnya saya membuat postingan Coding Import data dari Excel ke Database Ms. Acces Menggunakan VB 6.0. Nah pada postingan kali ini saya akan membuat kebalikannya yaitu bagaimana cara mengexport data dari database acces ke excel. Cara ini juga bisa digunakan untuk menampilkan laporan dengan bantuan excel. Ok, langsung saja ke TKP

Pertama copykan coding ini pada baris paling atas

Dim koneksi_ado As ADODB.Connection
Dim rsInfo As ADODB.Recordset

Setelah itu buatlah sebuah prosedur untuk koneksi ke databasenya dengan mencopy coding berikut ini:

Sub Koneksi()
Dim SQLStr As String
Set koneksi_ado = New ADODB.Connection
Set rsInfo = New ADODB.Recordset
koneksi_ado.ConnectionString = "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & MenuUtama.StatusBar1.Panels(4) & "\namaDb.mdb;Jet OLEDB:Database Password=XXXXX;Persist Security Info=False"
koneksi_ado.Open
adoInfo.Enabled = True
SQLStr = "select * from namatabel"
rsInfo.Open SQLStr, koneksi_ado, adOpenDynamic, adLockOptimistic
DataGrid1.Refresh
End Sub

Koneksi ini bisa ditempatkan saat form load ataupun ditaruh pada tombol tempat koding exportnya ditempatkan. Langkah selanjutnya buatlah sebuah prosedur untuk exportnya. Copykan coding berikut:

sub Export()
Dim EXCELAPPKU As Excel.Application
Dim excelbookku As Excel.Workbook
Dim excelsheetku As Excel.Worksheet
Dim baris, datake As Integer
Dim NamaFile, LokasiFile, Tgl, Bln, Tahun As String

Label1.Caption = "Status : Prosesing Data...."

Set EXCELAPPKU = New Excel.Application
Set excelbookku = EXCELAPPKU.Workbooks.Add

With EXCELAPPKU
.StandardFontSize = "10"
End With

EXCELAPPKU.Visible = True
Set excelsheetku = excelbookku.Worksheets(1)
excelsheetku.Select

'memberi judul pada tabel
With excelsheetku
    .Cells(1, 1).Value = "IdInfo"
    .Cells(1, 2).Value = "Kategori"
    .Cells(1, 3).Value = "tanggal"
    .Cells(1, 4).Value = "nama"
    .Cells(1, 5).Value = "alamat"
    .Cells(1, 6).Value = "IdLurah"
    .Cells(1, 7).Value = "Telpon"
    .Cells(1, 8).Value = "HP1"
    .Cells(1, 9).Value = "HP2"
    .Cells(1, 10).Value = "keterangan"
    .Cells(1, 11).Value = "status"
    .Cells(1, 12).Value = "cabang"
    
    baris = 2
    datake = 0

'menambahkan data yang ada di database ke dalam excel
    If Not rsInfo.BOF Then
        rsInfo.MoveFirst
        While Not rsInfo.EOF
            Label1.Caption = "Status : Exporting Data ke " & datake
            Label1.Refresh
            datake = datake + 1
            '.Cells(1, 5).Value = "Fetching data ke " & datake
            .Cells(baris, 1) = rsInfo![idinfo]
            .Cells(baris, 2) = rsInfo![kategori]
            .Cells(baris, 3) = rsInfo![tanggal]
            .Cells(baris, 3) = format(rsInfo![tanggal], "dd/mm/yy")
            .Cells(baris, 4) = rsInfo![nama]
            .Cells(baris, 5) = rsInfo![Alamat]
            .Cells(baris, 6) = rsInfo![IdLurah]
            .Cells(baris, 7) = rsInfo![Telpon]
            .Cells(baris, 8) = rsInfo![HP1]
            .Cells(baris, 9) = rsInfo![HP2]
            .Cells(baris, 10) = rsInfo![keterangan]
            .Cells(baris, 11) = rsInfo![Status]
            .Cells(baris, 12) = rsInfo![Cabang]
            baris = baris + 1
            rsInfo.MoveNext
        Wend
    End If
    'agar kolom fleksibel mengikuti panjang data yang ada di cell tersebut
    .Columns("A:A").EntireColumn.AutoFit
    .Columns("B:B").EntireColumn.AutoFit
    .Columns("C:C").EntireColumn.AutoFit
End With
rsInfo.Close

'menyimpan dan memberi nama file agar nama filenya ada tanggal bulan dan tahun dalam contoh ini nama filenya menjadi "Info_040615"
Tgl = format(Date, "DD")
Bln = format(Date, "mm")
Tahun = format(Date, "yy")
NamaFile = "Info_" & Tgl & Bln & Tahun & ".xlsx"
LokasiFile = "C:\TransferData\Dropbox\crm\" & NamaFile
excelsheetku.SaveAs LokasiFile
'#############################

On Error GoTo 0
Set excelsheetku = Nothing
Set excelbookku = Nothing

'setelah disimpan excel langsung tertutup. Jika ingin ditampilkan bisa hilangkan saja coding EXCELAPPKU.Quit
EXCELAPPKU.Quit
MsgBox "Export data selesai, mohon datanya diperiksa kembali..!", vbInformation, "Informasi"
Unload Me
end sub

Selanjutnya adalah tambahkan sebuah tombol untuk tombol exportnya. Apabila sudah dibuatkan tombolnya klik 2x pada tombol tersebut kemudian panggil prosedur koneksi dan export yang sudah kita buat tadi.

Private Sub Command1_Click()
koneksi
export
End Sub

Sekian postingan untuk kali ini. Semoba bisa membantu.

Artikel Terkait