Export Data Ke Excel

… Nostalgia …

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

'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…