Export Data Ke Excel

Harusnya sudah mengurangi “pertemanan” dengan Visual Basic 6, hehehe… akan tetapi kok nggak bisa yach…, masih terlalu cinta hehehe. Ya sudah…, saya mau share bagaimana caranya Export data ke Excel dengan VB6. Asumsinya adalah : Database yang digunakan Northwind bawaan SQL Server 2000. Dan tabelnya menggunakan Customers. Ok… Excelnya saya menggunakan yang 2003. Nanti tinggal disesuaikan saja.

1. Desain Form dengan satu Command Button.
2. Tambahkan Referensi dari Menu Project > References

3. Checklist “Microsoft ActiveX Data Object 2.1 Library” dan
“Microsoft Excel 11.0 Object Library” klik OK
4. Inilah kode program pada Form1

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58

'Program Untuk Export Data Ke Microsoft Excel Dim Con As New ADODB.Connection Dim Rs As New ADODB.Recordset Dim ExlObj As Excel.Application Dim Lc, NxtLine, K Private Sub Command1_Click() Set Con = New ADODB.Connection Con.Open "Provider=SqlOleDb; Data Source=ASP\YOGA;" _ & "Initial Catalog=Northwind; User Id=sa;" _ & "Password=password" Set Rs = New ADODB.Recordset Rs.CursorLocation = adUseClient Set ExlObj = CreateObject("Excel.Application") ExlObj.Workbooks.Add Set Rs = Nothing Rs.Open "SELECT CompanyName, ContactName, ContactTitle, Address, City, Country" _ & " From Customers", Con, adOpenDynamic, adLockOptimistic If Not Rs.EOF Then ExlObj.Visible = True With ExlObj.ActiveSheet .Cells(1, 3).Value = "CETAK SEMUA DATA CUSTOMER" .Cells(1, 3).Font.Name = "Tahoma" .Cells(1, 3).Font.Bold = True: .Cells(4, 1).Value = "Company Name": .Cells(4, 2).Value = "Contact Name" .Cells(4, 3).Value = "Contact Title": .Cells(4, 4).Value = "Address" .Cells(4, 5).Value = "City": .Cells(4, 6).Value = "Country" End With End If For K = 1 To Rs.Fields.Count ExlObj.ActiveSheet.Cells(4, K).Font.Bold = True Next Set K = Nothing NxtLine = 5 Do Until Rs.EOF For Lc = 0 To Rs.Fields.Count - 1 ExlObj.ActiveSheet.Cells(NxtLine, Lc + 1).Value = Rs.Fields(Lc) ExlObj.ActiveCell.Worksheet.Cells(NxtLine, Lc + 1).AutoFormat xlRangeAutoFormatList1, 0, regular, 3, 1, 1 Next Rs.MoveNext NxtLine = NxtLine + 1 Loop 'Set Password Untuk Memproteksi ExlObj.ActiveCell.Worksheet.Protect (rahasia) Set ExlObj = Nothing Rs.Close: Set Rs = Nothing Con.Close: Set Con = Nothing End Sub

5. Jalankan Aplikasi (F5), jika tidak ada Error, maka akan ditampilkan data pada Microsoft Excel.

Selamat mencoba…

sumber : http://blog.yogaprihastomo.com/category/visual-basic/