Import Data Excel Menggunakan DAO dan ADO

| Pada : Tuesday, June 29, 2010 | Terimakasih telah mengunjungi blog ini.


Contoh program ini mendemonstrasikan bagaimana cara untuk import data excel dengan menggunakan DAO atau ADO ke FlexGrid. 

Component :     


  1. Microsoft ActiveX Data Objects 2.6 Library
  2. Microsoft DAO 3.6 Object Library

Reference:

  • Microsoft FlexGrid Control 6
Download Code 


Option Explicit
Dim db As DAO.Database
Dim rsDAO As DAO.Recordset
Dim Conn As ADODB.Connection
Dim rsADO As ADODB.Recordset
Dim strDBField() As String ' Array untuk nama nama field Database.

Private Sub AccessDataWithDAO()

Set db = OpenDatabase(App.Path & "\test.xls", False, True, "Excel 8.0;")
DoEvents
Set rsDAO = db.OpenRecordset("SELECT * FROM [Sheet1$C6:D10]")
rsDAO.MoveFirst
Screen.MousePointer = vbHourglass
ReDim strDBField(1)
strDBField(0) = "Nama"
strDBField(1) = "Kota Lahir"
FillDataToGridControl
Screen.MousePointer = vbDefault
End Sub


Private Sub AccessDataWithADO()
Dim strConn As String
' Open koneksi ADO ke file Excel
strConn = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & App.Path & "\test.xls;" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""

Set Conn = New ADODB.Connection
Set rsADO = New ADODB.Recordset

Conn.ConnectionString = strConn
Conn.Open

' Pada file excel, definisikan nama ListURL dalam Sheet2
rsADO.Open "SELECT * FROM ListURL", Conn, adOpenDynamic, adLockOptimistic

If rsADO.RecordCount > 0 Then rsADO.MoveFirst
Screen.MousePointer = vbHourglass
ReDim strDBField(1)
strDBField(0) = "URL"
strDBField(1) = "Language"
FillDataToGridControl
Screen.MousePointer = vbDefault
End Sub
Private Sub opAksesData_Click(Index As Integer)
Set Conn = Nothing
Set rsADO = Nothing
Set db = Nothing
Set rsDAO = Nothing
Select Case Index
Case 0: AccessDataWithDAO
Case 1: AccessDataWithADO
Case Else
End Select
End Sub

Private Sub HeadingFlexGrid(oMSFlexGrid, nCol, cTextHeading, nColWidth)
With oMSFlexGrid
.TextMatrix(0, nCol) = cTextHeading
.ColWidth(nCol) = nColWidth
.Row = 0
.Col = nCol
.CellFontBold = True
.CellAlignment = flexAlignCenterCenter
End With
End Sub

 Private Sub FillDataToGridControl()
Dim rownum As Integer
Dim icount As Integer
Dim rs As Object

' Set recordset sesuai Option
If opAksesData(0) Then
Set rs = rsDAO
Else
Set rs = rsADO
End If

' Bersihkan data pada Grid dan setting row
MSFlexGrid1.Rows = 2
MSFlexGrid1.Clear

' Buat jumlah kolom sesuai dengan jumlah field(s)
If Not (MSFlexGrid1.Cols = UBound(strDBField, 1) + 1) Then
MSFlexGrid1.Cols = UBound(strDBField, 1) + 2
End If

' Setting grid header dan column.
Call HeadingFlexGrid(MSFlexGrid1, 0, "", 225)
Call HeadingFlexGrid(MSFlexGrid1, 1, strDBField(0), 3000)
Call HeadingFlexGrid(MSFlexGrid1, 2, strDBField(1), 2200)

' Isi grid dengan data dari cell file Excel.
rs.MoveFirst
Do Until rs.EOF
rownum = rownum + 1
MSFlexGrid1.AddItem ""
For icount = 0 To UBound(strDBField, 1)
MSFlexGrid1.TextMatrix(rownum, icount + 1) = _
rs.Fields(strDBField(icount))
Next
rs.MoveNext
Loop
rs.Close
Set rs = Nothing
End Sub
Share this article :

Free Source Code

Grab this Headline Animator

Artikel Terkait:

0 komentar:

Komentar Anda

Berikan komentar..

About Me

Followers

Home | Profile | Blogger | Template