[VB6] การดึงข้อมูล Excel มาแสดงผลลงตารางกริด ด้วยการใช้ ADO (ActiveX Data Object)
http://www.g2gnet.com/webboard/images/vb6/importexcelvb6.pngADO หรือ ActiveX Data Object เป็นเทคโนโลยีที่ช่วยให้แอพพลิเคชั่นต่างๆ สามารถเข้าถึงข้อมูลใดๆก็ได้ โดยอาศัยการเชื่อมต่อผ่าน OLEDB (โอเล่ดีบี) ซึ่งเป็นการอินเตอร์เฟสระดับล่าง (เราปล่อยให้ระบบมันไปคุยกันเอาเอง) ที่สามารถเข้าถึงแหล่งข้อมูลได้หลายประเภท ไม่ว่าจะเป็นไฟล์ฐานข้อมูล (DBMS), File System, Text หรือ Graphics รวมไปถึงแหล่งข้อมูลอื่นๆ ...
Add Reference ...
http://www.g2gnet.com/webboard/images/vb6/ado28.gif
Add Components ...
http://www.g2gnet.com/webboard/images/vb6/ADOandExcelComponent.gif
มาดูโค้ดฉบับเต็มกันเถอะ ...
Option Explicit
Dim Conn As ADODB.Connection
' / --------------------------------------------------------------------------------
' ฟังค์ชั่นที่ใช้ในการเปิดไฟล์ MS Excel
' และคืนค่ากลับ "จริง" หรือ "เท็จ" เพื่อแจ้งสถานะของการติดต่อไฟล์ด้วย
' / --------------------------------------------------------------------------------
Private Function Connect() As Boolean
On Error GoTo ErrorHandler
Set Conn = New ADODB.Connection
With Conn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "Data Source=" & txtPathNameXLS.Text & ";Extended Properties=Excel 8.0;"
.Open
End With
' แสดงว่าสามารถเปิดไฟล์ MS Excel ได้ (หรือ Connect - เชื่อมต่อได้) ก็แจ้งกลับด้วยสถานะที่เป็นจริง
Connect = True
ExitProc:
Exit Function
ErrorHandler:
' แจ้งสถานะของความผิดพลาด (Trap Error)
' เทคนิคการเขียนโปรแกรมของผมครับ ตรง Title MsgBox --> "Error: ฟังค์ชั่น Connect" ก็คือ
' ให้มันแจ้งการเกิด Error ในโปรแกรมย่อย (Sub program หรือ Function) ว่ามาจากตัวไหนกันแน่
' เวลาที่มีโปรแกรมย่อยเหล่านี้อยู่มากๆ ...ไม่งั้น งง ตาลาย 55555
MsgBox Err.Number & vbCrLf & Err.Description, vbOKOnly + vbCritical, "Error: ฟังค์ชั่น Connect"
' การติดต่อล้มเหลวผิดพลาด ต้องส่งค่ากลับเป็น False
Connect = False
' การใช้ Resume ในกรณีที่เกิด Error ขึ้นมา ส่วน GoTo มันกระโดดไปแบบไม่มีเงื่อนไขเลยครับ ... พี่น้อง
Resume ExitProc
End Function
' / --------------------------------------------------------------------------------
' ทำการอ่าน WorkSheet หรือเสมือนกับว่ามันคือตารางข้อมูล (Table) นั่นแหละครับพี่น้อง
' / --------------------------------------------------------------------------------
Private Sub GetExcelTables()
' ประกาศตัวแปร RecordSet
Dim RS As ADODB.Recordset
' ตัดการเชื่อมต่อเดิมทิ้งทั้งหมด
Set RS = New ADODB.Recordset
With Conn
' อ่านค่า Sheet ที่คุณเลือกเข้าสู่ RecordSet (มองเหมือนรูปแบบของตาราง - SchemaTables)
Set RS = .OpenSchema(adSchemaTables)
End With
'
' Loop ไปเรื่อยๆ จนกว่าจะหมดจำนวนของ WorkSheet
Do While Not RS.EOF
' นำชื่อ WorkSheet (หรือ ชื่อตาราง) มาใส่ไว้ใน ComboBox
cmbWorkSheet.AddItem (RS.Fields("TABLE_NAME").Value)
RS.MoveNext
Loop
'
End Sub
' / --------------------------------------------------------------------------------
' อ่านข้อมูลที่อยู่ในเซลล์ต่างๆเข้าสู่ Flexgrid
' เหมือนอ่านข้อมูลออกจากตาราง (Table) ใน MS Access ที่เราคุ้นเคยยังไงยังงั้นครับ ... พี่น้อง
' / --------------------------------------------------------------------------------
Private Sub GetExcelData()
Dim RS As ADODB.Recordset
Set RS = New ADODB.Recordset
With RS
.ActiveConnection = Conn
.CursorLocation = adUseClient
.CursorType = adOpenStatic
.LockType = adLockReadOnly
' ไม่บรรยายแล้วกัน SQL Statement
.Source = "SELECT * FROM [" & cmbWorkSheet.Text & "]"
.Open
' กำหนด DataSource ให้กับ FlexGrid
Set fgSheet.DataSource = RS
End With
RS.Close
Set RS = Nothing
End Sub
' / --------------------------------------------------------------------------------
' เริ่มต้นการเปิดไฟล์ Excel
' / --------------------------------------------------------------------------------
Private Sub cmdOpenXLS_Click()
'On Error Resume Next
On Error GoTo ErrHandler
With dlgOpenFile
.DialogTitle = "เลือกไฟล์ Microsoft Excel"
.InitDir = App.Path
' เลือกเฉพาะไฟล์ Excel
.Filter = "All Microsoft Excel Files (*.xls)|*.xls"
.ShowOpen
' ผมตั้งไว้เพื่อดักการกดปุ่ม Cancel ตอนเลือกไฟล์ครับ ซึ่งใช้ร่วมกับ On Error GoTo ErrHandler
' และต้องสั่งให้ dlgOpenFile.CancelError = True
' เพื่อให้เกิดการแจ้ง Errorโดย Err.Number = 32755 หมายความว่าเกิดการกดปุ่ม Cancel
' ตรงนี้ผมอธิบายให้ลึกซึ้งมันยากครับ โปรดลองเล่นดูเอาล่ะกัน
.CancelError = True
If .FileName <> "" Then txtPathNameXLS.Text = .FileName
End With
' ไม่มีชื่อไฟล์กลับมาน่ะขอรับ ดังนั้นจะให้มันไปฟังค์ชั่น Connect ทำไมให้เกิด Error เล่า ... พี่น้อง
If txtPathNameXLS.Text = "" Then Exit Sub
'
If Connect Then
cmbWorkSheet.Clear
Call GetExcelTables
End If
ExitProc:
Exit Sub
ErrHandler:
Select Case Err.Number
Case 32755
Err.Clear
Exit Sub
' หรือคอย Trap Error ตัวอื่นๆ
' Case xxxx
' แจ้งความผิดพลาดเกี่ยวกับอะไร ...
Case Else
MsgBox Err.Number & vbCrLf & Err.Description
End Select
End Sub
Private Sub cmbWorkSheet_Click()
If cmbWorkSheet.ListIndex < 0 Then Exit Sub
' เรียกการแสดงผลเข้าสู่ FlexGrid
Call GetExcelData
End Sub
Private Sub Form_Load()
txtPathNameXLS.Text = ""
cmbWorkSheet.Clear
lblDescription.Caption = "โปรแกรมตัวอย่างการใช้งาน ADO และ MS Excel - www.g2gnet.com"
Me.Move (Screen.Width - Width) \ 2, (Screen.Height - Height) \ 2
End Sub
Private Sub Form_Resize()
On Error Resume Next
Me.fraOpenExcel.Move 0, 30, Me.ScaleWidth - 30, Me.ScaleHeight - Me.Picture1.Height - 60
Me.fgSheet.Move 30, 1200, Me.fraOpenExcel.Width - 90, Me.fraOpenExcel.Height - 1260
Me.Picture1.Move 0, Me.fraOpenExcel.Height + 30, Me.ScaleWidth - 30
Me.lblDescription.Move 0, 0, Me.Picture1.Width
End Sub
Private Sub cmdExit_Click()
End
End Sub
ดาวน์โหลดโค้ดต้นฉบับ VB6 ได้ที่นี่ ...
ขอบคุณครับ
หน้า:
[1]