ชุมชนคนรักภาษาเบสิค - Visual Basic Community

 ลืมรหัสผ่าน
 ลงทะเบียน
ค้นหา
ดู: 566|ตอบกลับ: 0

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

[คัดลอกลิงก์]

252

กระทู้

367

โพสต์

3068

เครดิต

ผู้ดูแลระบบ

Rank: 9Rank: 9Rank: 9

เครดิต
3068




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. ' ฟังค์ชั่นที่ใช้ในการเปิดไฟล์ MS Excel
  5. ' และคืนค่ากลับ "จริง" หรือ "เท็จ" เพื่อแจ้งสถานะของการติดต่อไฟล์ด้วย
  6. ' / --------------------------------------------------------------------------------
  7. Private Function Connect() As Boolean
  8. On Error GoTo ErrorHandler
  9.     Set Conn = New ADODB.Connection
  10.     With Conn
  11.         .Provider = "Microsoft.Jet.OLEDB.4.0"
  12.         .ConnectionString = "Data Source=" & txtPathNameXLS.Text & ";Extended Properties=Excel 8.0;"
  13.         .Open
  14.     End With
  15.    
  16.     ' แสดงว่าสามารถเปิดไฟล์ MS Excel ได้ (หรือ Connect - เชื่อมต่อได้) ก็แจ้งกลับด้วยสถานะที่เป็นจริง
  17.     Connect = True
  18. ExitProc:
  19.     Exit Function
  20.    
  21. ErrorHandler:
  22.     ' แจ้งสถานะของความผิดพลาด (Trap Error)
  23.     ' เทคนิคการเขียนโปรแกรมของผมครับ ตรง Title MsgBox --> "Error: ฟังค์ชั่น Connect" ก็คือ
  24.     ' ให้มันแจ้งการเกิด Error ในโปรแกรมย่อย (Sub program หรือ Function) ว่ามาจากตัวไหนกันแน่
  25.     ' เวลาที่มีโปรแกรมย่อยเหล่านี้อยู่มากๆ ...  ไม่งั้น งง ตาลาย 55555
  26.     MsgBox Err.Number & vbCrLf & Err.Description, vbOKOnly + vbCritical, "Error: ฟังค์ชั่น Connect"
  27.    
  28.     ' การติดต่อล้มเหลวผิดพลาด ต้องส่งค่ากลับเป็น False
  29.     Connect = False
  30.    
  31.     ' การใช้ Resume ในกรณีที่เกิด Error ขึ้นมา ส่วน GoTo มันกระโดดไปแบบไม่มีเงื่อนไขเลยครับ ... พี่น้อง
  32.     Resume ExitProc
  33. End Function

  34. ' / --------------------------------------------------------------------------------
  35. ' ทำการอ่าน WorkSheet หรือเสมือนกับว่ามันคือตารางข้อมูล (Table) นั่นแหละครับพี่น้อง
  36. ' / --------------------------------------------------------------------------------
  37. Private Sub GetExcelTables()
  38.     ' ประกาศตัวแปร RecordSet
  39.     Dim RS As ADODB.Recordset
  40.     ' ตัดการเชื่อมต่อเดิมทิ้งทั้งหมด
  41.     Set RS = New ADODB.Recordset
  42.     With Conn
  43.         ' อ่านค่า Sheet ที่คุณเลือกเข้าสู่ RecordSet (มองเหมือนรูปแบบของตาราง - SchemaTables)
  44.         Set RS = .OpenSchema(adSchemaTables)
  45.     End With
  46.     '
  47.     ' Loop ไปเรื่อยๆ จนกว่าจะหมดจำนวนของ WorkSheet
  48.     Do While Not RS.EOF
  49.         ' นำชื่อ WorkSheet (หรือ ชื่อตาราง) มาใส่ไว้ใน ComboBox
  50.         cmbWorkSheet.AddItem (RS.Fields("TABLE_NAME").Value)
  51.         RS.MoveNext
  52.     Loop
  53.     '
  54. End Sub

  55. ' / --------------------------------------------------------------------------------
  56. ' อ่านข้อมูลที่อยู่ในเซลล์ต่างๆเข้าสู่ Flexgrid
  57. ' เหมือนอ่านข้อมูลออกจากตาราง (Table) ใน MS Access ที่เราคุ้นเคยยังไงยังงั้นครับ ... พี่น้อง
  58. ' / --------------------------------------------------------------------------------
  59. Private Sub GetExcelData()
  60.     Dim RS As ADODB.Recordset
  61.     Set RS = New ADODB.Recordset
  62.     With RS
  63.         .ActiveConnection = Conn
  64.         .CursorLocation = adUseClient
  65.         .CursorType = adOpenStatic
  66.         .LockType = adLockReadOnly
  67.         ' ไม่บรรยายแล้วกัน SQL Statement
  68.         .Source = "SELECT * FROM [" & cmbWorkSheet.Text & "]"
  69.         .Open
  70.         
  71.         ' กำหนด DataSource ให้กับ FlexGrid
  72.         Set fgSheet.DataSource = RS
  73.     End With
  74.     RS.Close
  75.     Set RS = Nothing
  76. End Sub

  77. ' / --------------------------------------------------------------------------------
  78. ' เริ่มต้นการเปิดไฟล์ Excel
  79. ' / --------------------------------------------------------------------------------
  80. Private Sub cmdOpenXLS_Click()
  81. 'On Error Resume Next
  82. On Error GoTo ErrHandler
  83.     With dlgOpenFile
  84.         .DialogTitle = "เลือกไฟล์ Microsoft Excel"
  85.         .InitDir = App.Path
  86.         ' เลือกเฉพาะไฟล์ Excel
  87.         .Filter = "All Microsoft Excel Files (*.xls)|*.xls"
  88.         .ShowOpen
  89.         
  90.         ' ผมตั้งไว้เพื่อดักการกดปุ่ม Cancel ตอนเลือกไฟล์ครับ ซึ่งใช้ร่วมกับ On Error GoTo ErrHandler
  91.         ' และต้องสั่งให้ dlgOpenFile.CancelError = True
  92.         ' เพื่อให้เกิดการแจ้ง Error  โดย Err.Number = 32755 หมายความว่าเกิดการกดปุ่ม Cancel
  93.         ' ตรงนี้ผมอธิบายให้ลึกซึ้งมันยากครับ โปรดลองเล่นดูเอาล่ะกัน
  94.         .CancelError = True
  95.         If .FileName <> "" Then txtPathNameXLS.Text = .FileName
  96.     End With
  97.    
  98.     ' ไม่มีชื่อไฟล์กลับมาน่ะขอรับ ดังนั้นจะให้มันไปฟังค์ชั่น Connect ทำไมให้เกิด Error เล่า ... พี่น้อง
  99.     If txtPathNameXLS.Text = "" Then Exit Sub
  100.     '
  101.     If Connect Then
  102.         cmbWorkSheet.Clear
  103.         Call GetExcelTables
  104.     End If

  105. ExitProc:
  106.     Exit Sub

  107. ErrHandler:
  108.     Select Case Err.Number
  109.     Case 32755
  110.         Err.Clear
  111.         Exit Sub
  112.     ' หรือคอย Trap Error ตัวอื่นๆ
  113.     ' Case xxxx
  114.         ' แจ้งความผิดพลาดเกี่ยวกับอะไร ...
  115.    
  116.     Case Else
  117.         MsgBox Err.Number & vbCrLf & Err.Description
  118.     End Select
  119. End Sub

  120. Private Sub cmbWorkSheet_Click()
  121.     If cmbWorkSheet.ListIndex < 0 Then Exit Sub
  122.     ' เรียกการแสดงผลเข้าสู่ FlexGrid
  123.     Call GetExcelData
  124. End Sub

  125. Private Sub Form_Load()
  126.     txtPathNameXLS.Text = ""
  127.     cmbWorkSheet.Clear
  128.     lblDescription.Caption = "โปรแกรมตัวอย่างการใช้งาน ADO และ MS Excel - www.g2gnet.com"
  129.     Me.Move (Screen.Width - Width) \ 2, (Screen.Height - Height) \ 2
  130. End Sub

  131. Private Sub Form_Resize()
  132.     On Error Resume Next
  133.     Me.fraOpenExcel.Move 0, 30, Me.ScaleWidth - 30, Me.ScaleHeight - Me.Picture1.Height - 60
  134.     Me.fgSheet.Move 30, 1200, Me.fraOpenExcel.Width - 90, Me.fraOpenExcel.Height - 1260
  135.     Me.Picture1.Move 0, Me.fraOpenExcel.Height + 30, Me.ScaleWidth - 30
  136.     Me.lblDescription.Move 0, 0, Me.Picture1.Width
  137. End Sub

  138. Private Sub cmdExit_Click()
  139.     End
  140. End Sub
คัดลอกไปที่คลิปบอร์ด



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

ขออภัย! โพสต์นี้มีไฟล์แนบหรือรูปภาพที่ไม่ได้รับอนุญาตให้คุณเข้าถึง

คุณจำเป็นต้อง ลงชื่อเข้าใช้ เพื่อดาวน์โหลดหรือดูไฟล์แนบนี้ คุณยังไม่มีบัญชีใช่ไหม? ลงทะเบียน

x
สิ่งที่ดีกว่าการให้ คือการให้แบบไม่มีที่สิ้นสุด
ขออภัย! คุณไม่ได้รับสิทธิ์ในการดำเนินการในส่วนนี้ กรุณาเลือกอย่างใดอย่างหนึ่ง ลงชื่อเข้าใช้ | ลงทะเบียน

รายละเอียดเครดิต

ข้อความล้วน|อุปกรณ์พกพา|ประวัติการแบน|G2GNet.com  

GMT+7, 2020-9-21 11:11 , Processed in 0.617943 second(s), 4 queries , File On.

Powered by Discuz! X3.3 R20170401, Rev.54

© 2001-2017 Comsenz Inc.

ตอบกระทู้ ขึ้นไปด้านบน ไปที่หน้ารายการกระทู้