transfer data from access database into excell with vbtransfer data from access database into excell with vb

Senin, 04 Oktober 2010

transfer data from access database into excell with vb



Option Explicit
Dim con As ADODB.Connection
Dim rec As ADODB.Recordset
Dim connectString As String
Dim objExcel As Object
Dim objTemp As Object

Public Sub excel(rec As ADODB.Recordset)
Dim indexbaris As Integer
Dim indexcolom As Integer
Dim jmlrecord As Integer
Dim jmlfield As Integer
Dim totalbaris As Variant
Dim excelVersion As Integer

totalbaris = rec.GetRows()

jmlrecord = UBound(totalbaris, 2) + 1
jmlfield = UBound(totalbaris, 1) + 1

Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.Workbooks.Add

Set objTemp = objExcel
excelVersion = Val(objExcel.Application.Version)
If (excelVersion >= 8) Then
Set objExcel = objExcel.ActiveSheet
End If

indexbaris = 1
indexcolom = 1
For indexcolom = 1 To jmlfield
With objExcel.Cells(indexbaris, indexcolom)
.Value = rec.Fields(indexcolom - 1).Name
With .Font
.Name = "Tahoma"
.Bold = True
.Size = 8
End With
End With
Next

rec.Close
Set rec = Nothing

With objExcel
For indexbaris = 2 To jmlrecord + 1
For indexcolom = 1 To jmlfield
.Cells(indexbaris, indexcolom).Value = totalbaris(indexcolom - 1, indexbaris - 2)
Next
Next
End With

objExcel.Cells(1, 1).CurrentRegion.EntireColumn.AutoFit
End Sub

Private Sub Form_Activate()
Dim SqlString As String

Set con = New ADODB.Connection
Set rec = New ADODB.Recordset

connectString = "Provider=Microsoft.Jet.OLEDB.3.51;" _
& "Data Source=C:\Program Files\Microsoft Visual Studio\VB98\BIBLIO.MDB"

SqlString = "SELECT * FROM Publishers where PubID <= 50" con.Open connectString rec.CursorLocation = adUseClient rec.Open SqlString, con End Sub Private Sub Command1_Click() Call excel(rec) End Sub

Tidak ada komentar:

Posting Komentar