Export Data Access ke Excel via Visual Basic

Private Sub Command1_Click()
Dim app As Application
Dim wbk As Workbook
Dim sheet As Worksheet
Set app = Excel.Application
Set wbk = app.Workbooks.Add
Set sheet = wbk.Worksheets(1)
sheet.Cells(5, 5) = "Kode"
sheet.Cells(5, 6) = "Nama Hardware"
sheet.Range("E5:F5").Font.Bold = True
sheet.Range("E5:F5").Borders.LineStyle = xlContinuous
ActiveWindow.DisplayGridlines = False
With RstHardwareExcel
.MoveFirst

n =
5
For i = 1 To .RecordCount
sheet.Cells(n + i, 5) = .Fields(0)
sheet.Cells(n + i, 6) = .Fields(1)
sheet.Range("E" & n+i & ":F" & n+i).Borders.LineStyle=xlContinuous
.MoveNext
Next i
End With
sheet.Range("E5").EntireColumn.AutoFit
sheet.Range("F5").EntireColumn.AutoFit
Me.CommonDialog1.DialogTitle = "File Name"
Me.CommonDialog1.Filter = "File Excel|*.xls"
Me.CommonDialog1.ShowSave
wbk.SaveAs Me.CommonDialog1.FileName
wbk.Close
app.Quit
Set sheet = Nothing
Set wbk = Nothing
Set app = Nothing

End Sub


Private Sub Form_Load()

BukaKoneksi

BukaHardwareExcel

End Sub


Private Sub Form_Unload(Cancel As Integer)

TutupHardwareExcel
TutupKoneksi

End Sub


*) Untuk koneksi Database Access saya menggunakan Modul, berikut dibawah ini adalah isi dari Modul yang saya buat di VB


Public Koneksi As ADODB.C
onnection
Public RstHardwareExcel As ADODB.Recordset

Sub BukaKoneksi()

Set Koneksi = CreateObject("ADODB.Connection")

Koneksi.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" &
app.Path & "\data.mdb"
End Sub


Sub BukaHardwareExcel()

Set RstHardwareExcel = CreateObject("ADODB.RecordSet")

RstHardwareExcel.Open "Hardware", Koneksi, adOpenStatic,adLockOptimistic

End Sub


Sub TutupKoneksi()

Koneksi.Close
Set Koneksi = Nothing

End Sub

Dibawah ini merupakan Contoh Form ketika saya jalankan

*) Setelah Form muncul berikutnya
diclick Command1 maka akan muncul tampilan CommondDialog dalam bentuk ShowSave seperti dibawah ini





Ketika muncul Commond Dialog dengan bentuk ShowSave maka berikutnya silahkan diberi nama filenya, maka akan muncul file Excel dengan nama tersebut.

Nah tinggal dicek aja

Selamat Mencoba


Download sekarang

1 komentar:

Ferlyarasi mengatakan...

link nya dah hangus bang