[VB6] การดึงข้อมูล Excel มาแสดงผลลงตารางกริด ด้วยการใช้ ADO (ActiveX Data Object)

thongkorn

ADO หรือ ActiveX Data Object เป็นเทคโนโลยีที่ช่วยให้แอพพลิเคชั่นต่างๆ สามารถเข้าถึงข้อมูลใดๆก็ได้ โดยอาศัยการเชื่อมต่อผ่าน OLEDB (โอเล่ดีบี) ซึ่งเป็นการอินเตอร์เฟสระดับล่าง (เราปล่อยให้ระบบมันไปคุยกันเอาเอง) ที่สามารถเข้าถึงแหล่งข้อมูลได้หลายประเภท ไม่ว่าจะเป็นไฟล์ฐานข้อมูล (DBMS), File System, Text หรือ Graphics รวมไปถึงแหล่งข้อมูลอื่นๆ ...


Add Reference ...



Add Components ...



มาดูโค้ดฉบับเต็มกันเถอะ ...

1. Option Explicit
   
2. Dim Conn As ADODB.Connection
   
3. 
   
4. ' / --------------------------------------------------------------------------------
   
5. ' ฟังค์ชั่นที่ใช้ในการเปิดไฟล์ MS Excel
   
6. ' และคืนค่ากลับ "จริง" หรือ "เท็จ" เพื่อแจ้งสถานะของการติดต่อไฟล์ด้วย
   
7. ' / --------------------------------------------------------------------------------
   
8. Private Function Connect() As Boolean
   
9. On Error GoTo ErrorHandler
   
10.     Set Conn = New ADODB.Connection
    
11.     With Conn
    
12.         .Provider = "Microsoft.Jet.OLEDB.4.0"
    
13.         .ConnectionString = "Data Source=" & txtPathNameXLS.Text & ";Extended Properties=Excel 8.0;"
    
14.         .Open
    
15.     End With
    
16.    
    
17.     ' แสดงว่าสามารถเปิดไฟล์ MS Excel ได้ (หรือ Connect - เชื่อมต่อได้) ก็แจ้งกลับด้วยสถานะที่เป็นจริง
    
18.     Connect = True
    
19. ExitProc:
    
20.     Exit Function
    
21.    
    
22. ErrorHandler:
    
23.     ' แจ้งสถานะของความผิดพลาด (Trap Error)
    
24.     ' เทคนิคการเขียนโปรแกรมของผมครับ ตรง Title MsgBox --> "Error: ฟังค์ชั่น Connect" ก็คือ
    
25.     ' ให้มันแจ้งการเกิด Error ในโปรแกรมย่อย (Sub program หรือ Function) ว่ามาจากตัวไหนกันแน่
    
26.     ' เวลาที่มีโปรแกรมย่อยเหล่านี้อยู่มากๆ ...  ไม่งั้น งง ตาลาย 55555
    
27.     MsgBox Err.Number & vbCrLf & Err.Description, vbOKOnly + vbCritical, "Error: ฟังค์ชั่น Connect"
    
28.    
    
29.     ' การติดต่อล้มเหลวผิดพลาด ต้องส่งค่ากลับเป็น False
    
30.     Connect = False
    
31.    
    
32.     ' การใช้ Resume ในกรณีที่เกิด Error ขึ้นมา ส่วน GoTo มันกระโดดไปแบบไม่มีเงื่อนไขเลยครับ ... พี่น้อง
    
33.     Resume ExitProc
    
34. End Function
    
35. 
    
36. ' / --------------------------------------------------------------------------------
    
37. ' ทำการอ่าน WorkSheet หรือเสมือนกับว่ามันคือตารางข้อมูล (Table) นั่นแหละครับพี่น้อง
    
38. ' / --------------------------------------------------------------------------------
    
39. Private Sub GetExcelTables()
    
40.     ' ประกาศตัวแปร RecordSet
    
41.     Dim RS As ADODB.Recordset
    
42.     ' ตัดการเชื่อมต่อเดิมทิ้งทั้งหมด
    
43.     Set RS = New ADODB.Recordset
    
44.     With Conn
    
45.         ' อ่านค่า Sheet ที่คุณเลือกเข้าสู่ RecordSet (มองเหมือนรูปแบบของตาราง - SchemaTables)
    
46.         Set RS = .OpenSchema(adSchemaTables)
    
47.     End With
    
48.     '
    
49.     ' Loop ไปเรื่อยๆ จนกว่าจะหมดจำนวนของ WorkSheet
    
50.     Do While Not RS.EOF
    
51.         ' นำชื่อ WorkSheet (หรือ ชื่อตาราง) มาใส่ไว้ใน ComboBox
    
52.         cmbWorkSheet.AddItem (RS.Fields("TABLE_NAME").Value)
    
53.         RS.MoveNext
    
54.     Loop
    
55.     '
    
56. End Sub
    
57. 
    
58. ' / --------------------------------------------------------------------------------
    
59. ' อ่านข้อมูลที่อยู่ในเซลล์ต่างๆเข้าสู่ Flexgrid
    
60. ' เหมือนอ่านข้อมูลออกจากตาราง (Table) ใน MS Access ที่เราคุ้นเคยยังไงยังงั้นครับ ... พี่น้อง
    
61. ' / --------------------------------------------------------------------------------
    
62. Private Sub GetExcelData()
    
63.     Dim RS As ADODB.Recordset
    
64.     Set RS = New ADODB.Recordset
    
65.     With RS
    
66.         .ActiveConnection = Conn
    
67.         .CursorLocation = adUseClient
    
68.         .CursorType = adOpenStatic
    
69.         .LockType = adLockReadOnly
    
70.         ' ไม่บรรยายแล้วกัน SQL Statement
    
71.         .Source = "SELECT * FROM [" & cmbWorkSheet.Text & "]"
    
72.         .Open
    
73.         
    
74.         ' กำหนด DataSource ให้กับ FlexGrid
    
75.         Set fgSheet.DataSource = RS
    
76.     End With
    
77.     RS.Close
    
78.     Set RS = Nothing
    
79. End Sub
    
80. 
    
81. ' / --------------------------------------------------------------------------------
    
82. ' เริ่มต้นการเปิดไฟล์ Excel
    
83. ' / --------------------------------------------------------------------------------
    
84. Private Sub cmdOpenXLS_Click()
    
85. 'On Error Resume Next
    
86. On Error GoTo ErrHandler
    
87.     With dlgOpenFile
    
88.         .DialogTitle = "เลือกไฟล์ Microsoft Excel"
    
89.         .InitDir = App.Path
    
90.         ' เลือกเฉพาะไฟล์ Excel
    
91.         .Filter = "All Microsoft Excel Files (*.xls)|*.xls"
    
92.         .ShowOpen
    
93.         
    
94.         ' ผมตั้งไว้เพื่อดักการกดปุ่ม Cancel ตอนเลือกไฟล์ครับ ซึ่งใช้ร่วมกับ On Error GoTo ErrHandler
    
95.         ' และต้องสั่งให้ dlgOpenFile.CancelError = True
    
96.         ' เพื่อให้เกิดการแจ้ง Error  โดย Err.Number = 32755 หมายความว่าเกิดการกดปุ่ม Cancel
    
97.         ' ตรงนี้ผมอธิบายให้ลึกซึ้งมันยากครับ โปรดลองเล่นดูเอาล่ะกัน
    
98.         .CancelError = True
    
99.         If .FileName <> "" Then txtPathNameXLS.Text = .FileName
    
100.     End With
     
101.    
     
102.     ' ไม่มีชื่อไฟล์กลับมาน่ะขอรับ ดังนั้นจะให้มันไปฟังค์ชั่น Connect ทำไมให้เกิด Error เล่า ... พี่น้อง
     
103.     If txtPathNameXLS.Text = "" Then Exit Sub
     
104.     '
     
105.     If Connect Then
     
106.         cmbWorkSheet.Clear
     
107.         Call GetExcelTables
     
108.     End If
     
109. 
     
110. ExitProc:
     
111.     Exit Sub
     
112. 
     
113. ErrHandler:
     
114.     Select Case Err.Number
     
115.     Case 32755
     
116.         Err.Clear
     
117.         Exit Sub
     
118.     ' หรือคอย Trap Error ตัวอื่นๆ
     
119.     ' Case xxxx
     
120.         ' แจ้งความผิดพลาดเกี่ยวกับอะไร ...
     
121.    
     
122.     Case Else
     
123.         MsgBox Err.Number & vbCrLf & Err.Description
     
124.     End Select
     
125. End Sub
     
126. 
     
127. Private Sub cmbWorkSheet_Click()
     
128.     If cmbWorkSheet.ListIndex < 0 Then Exit Sub
     
129.     ' เรียกการแสดงผลเข้าสู่ FlexGrid
     
130.     Call GetExcelData
     
131. End Sub
     
132. 
     
133. Private Sub Form_Load()
     
134.     txtPathNameXLS.Text = ""
     
135.     cmbWorkSheet.Clear
     
136.     lblDescription.Caption = "โปรแกรมตัวอย่างการใช้งาน ADO และ MS Excel - www.g2gnet.com"
     
137.     Me.Move (Screen.Width - Width) \ 2, (Screen.Height - Height) \ 2
     
138. End Sub
     
139. 
     
140. Private Sub Form_Resize()
     
141.     On Error Resume Next
     
142.     Me.fraOpenExcel.Move 0, 30, Me.ScaleWidth - 30, Me.ScaleHeight - Me.Picture1.Height - 60
     
143.     Me.fgSheet.Move 30, 1200, Me.fraOpenExcel.Width - 90, Me.fraOpenExcel.Height - 1260
     
144.     Me.Picture1.Move 0, Me.fraOpenExcel.Height + 30, Me.ScaleWidth - 30
     
145.     Me.lblDescription.Move 0, 0, Me.Picture1.Width
     
146. End Sub
     
147. 
     
148. Private Sub cmdExit_Click()
     
149.     End
     
150. End Sub

คัดลอกไปที่คลิปบอร์ด

ดาวน์โหลดโค้ดต้นฉบับ VB6 ได้ที่นี่ ...

g2gsoftuser

ขอบคุณครับ