[VB.NET] โค้ดการอ่านโครงสร้าง DBase File แล้วเลือกฟิลด์ข้อมูลเพื่อนำมาแสดงผลในตารางกริด

thongkorn · โพสต์ 2019-5-29 11:55:47

DBase File ก็เป็นระดับไฟล์เบส (File DataBase) เหมือนกันกับ MS Access แต่ว่า DBase หรือไฟล์ที่มีนามสกุล DBF จะแยกเป็น 1 ไฟล์ต่อ 1 ตารางข้อมูล ดังนั้นเวลาเราเลือกมาใช้งานเพื่อทำการ Query เราจะต้องทำการแยกชื่อไฟล์ออกจากนามสกุลเสียก่อน ...

การจะเชื่อมต่อหรือพูดคุยกับฐานข้อมูล DBF ได้ จะต้องทำผ่าน Object Linking and Embedding หรือ OLE (อ่านว่าโอเล่) สำหรับ FoxPro ...
ดาวน์โหลดและทำการติดตั้ง Microsoft OLE DB Provider for Visual FoxPro 9.0 ...

การ Add Reference MS Excel (แอดมินใช้ Office 2010 หรือ เวอร์ชั่น 14 หากไม่ตรงกับรุ่นของแอดมิน ต้องทำการเลือกเข้ามาใหม่ก่อนครับ)

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

Imports System.Data.OleDb
Imports Excel = Microsoft.Office.Interop.Excel
Public Class frmViewDataDBF
Dim Conn As OleDbConnection
Dim Cmd As OleDbCommand
Dim dbfName As String
Private Sub frmViewDataDBF_FormClosed(sender As Object, e As System.Windows.Forms.FormClosedEventArgs) Handles Me.FormClosed
Me.Dispose()
Application.Exit()
End Sub
'// ต้องกำหนดให้ฟอร์มมีคุณสมบัติ KeyPreview = True
Private Sub frmViewDataDBF_KeyDown(sender As Object, e As System.Windows.Forms.KeyEventArgs) Handles Me.KeyDown
Select Case e.KeyCode
Case Keys.F7
Call btnQuery_Click(sender, e)
Case Keys.F10
Me.Close()
Case Keys.F6
Call itemExportXLS_Click(sender, e)
End Select
End Sub
Private Sub frmViewDataDBF_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
Me.CenterToScreen()
Me.ToolStrip1.Cursor = Cursors.Hand
Me.KeyPreview = True
End Sub
Private Sub btnBrowseFile_Click(sender As System.Object, e As System.EventArgs) Handles btnBrowseFile.Click
' ประกาศใช้งาน Open File Dialog ในแบบ Run Time
Dim dlgOpenFile As OpenFileDialog = New OpenFileDialog()
' / ตั้งค่าการใช้งาน Open File Dialog
With dlgOpenFile
.InitialDirectory = MyPath(Application.StartupPath)
.Title = "เลือกไฟล์ DBF"
.Filter = "DBase Files (*.dbf)|*.dbf"
.FilterIndex = 1
.RestoreDirectory = True
End With
Dim strConn As String = ""
Try
'/ หากเลือกปุ่ม OK หลังจากการ Browse ...
If dlgOpenFile.ShowDialog() = DialogResult.OK Then
lsbSource.Items.Clear()
lsbDest.Items.Clear()
'//
txtFileName.Text = dlgOpenFile.FileName
strConn = "Provider=VFPOLEDB.1;Data Source=" & dlgOpenFile.FileName & ";"
dbfName = dlgOpenFile.FileName
Dim sArr() As String
sArr = Split(dbfName, "")
'// แยกโฟลเดอร์, ไฟล์ และ นามสกุล ออกให้หมดจนเหลือเพียงแต่ชื่อไฟล์เท่านั้น
'// เช่น C:\Data\Sample.dbf --> จะต้องเหลือเพียง Sample ซึ่งจะแทนชื่อตารางนั่นเอง
dbfName = Microsoft.VisualBasic.Left(sArr(UBound(sArr)), (InStrRev(sArr(UBound(sArr)), ".") - 1))
Dim strSQL As String = "SELECT * FROM " & dbfName
Conn = New OleDbConnection(strConn)
Conn.Open()
'// อ่านค่ารายชื่อตาราง (TABLE)
Dim DT As New DataTable
DT = Conn.GetOleDbSchemaTable(OleDbSchemaGuid.Columns, New Object() {Nothing, Nothing, dbfName, Nothing})
For i = 0 To DT.Rows.Count - 1
lsbSource.Items.Add(DT.Rows(i).Item(3).ToString())
Next i
DT.Dispose()
End If
Catch ex As Exception
MessageBox.Show(ex.Message)
End Try
End Sub
' / --------------------------------------------------------------------------------
' / Get my project path
' / AppPath = C:\My Project\bin\debug
' / Replace "\bin\debug" with ""
' / Return : C:\My Project\
Function MyPath(AppPath As String) As String
'/ MessageBox.Show(AppPath);
AppPath = AppPath.ToLower()
'/ Return Value
MyPath = AppPath.Replace("\bin\debug", "").Replace("\bin\release", "").Replace("\bin\x86\debug", "")
'// If not found folder then put the \ (BackSlash) at the end.
If Microsoft.VisualBasic.Right(MyPath, 1) <> "" Then MyPath = MyPath & ""
End Function
Private Sub btnMoveRight_Click(sender As System.Object, e As System.EventArgs) Handles btnMoveRight.Click
'// ยังไม่ได้เลือกไอเทม
If lsbSource.SelectedIndex < 0 Then
MessageBox.Show("กรุณาเลือกไอเทมในรายการที่ 1 ก่อน.", "รายงานสถานะ", MessageBoxButtons.OK, MessageBoxIcon.Information)
Else
'// เพิ่มไอเทมที่เลือกจาก lsbSource ไปให้กับ lsbDest
lsbDest.Items.Add(lsbSource.SelectedItem)
'// ลบไอเทมที่เลือกใน lsbSource ออกไป
lsbSource.Items.Remove(lsbSource.SelectedItem)
End If
End Sub
Private Sub btnMoveLeft_Click(sender As System.Object, e As System.EventArgs) Handles btnMoveLeft.Click
If lsbDest.SelectedIndex < 0 Then
MessageBox.Show("กรุณาเลือกไอเทมในรายการที่ 2 ก่อน.", "รายงานสถานะ", MessageBoxButtons.OK, MessageBoxIcon.Information)
Else
'// เพิ่มไอเทมที่เลือกจาก lsbDest ไปให้กับ lsbSource
lsbSource.Items.Add(lsbDest.SelectedItem)
'// ลบไอเทมที่เลือกใน lsbDest ออกไป
lsbDest.Items.Remove(lsbDest.SelectedItem)
End If
End Sub
Private Sub btnMoveRightAll_Click(sender As System.Object, e As System.EventArgs) Handles btnMoveRightAll.Click
'// ลูปเอาไอเทมทั้งหมดที่มีอยู่ใน lsbSource ไปให้กับ lsbDest
For Each item In lsbSource.Items
lsbDest.Items.Add(item)
Next
'// ลบไอเทมที่มีอยู่ทั้งหมดใน lsbSource ออกไป
lsbSource.Items.Clear()
End Sub
Private Sub btnMoveLeftAll_Click(sender As System.Object, e As System.EventArgs) Handles btnMoveLeftAll.Click
'// ลูปเอาไอเทมทั้งหมดที่มีอยู่ใน lsbDest ไปให้กับ lsbSource
For Each item In lsbDest.Items
lsbSource.Items.Add(item)
Next
'// ลบไอเทมที่มีอยู่ทั้งหมดใน lsbDest ออกไป
lsbDest.Items.Clear()
End Sub
Private Sub btnClose_Click(sender As System.Object, e As System.EventArgs)
Me.Close()
End Sub
Private Sub btnQuery_Click(sender As System.Object, e As System.EventArgs) Handles btnQuery.Click
If lsbDest.Items.Count <= 0 Then Exit Sub
If dgvData.Rows.Count > 0 Then dgvData.DataSource = Nothing
Try
Dim FieldName As String = String.Empty
For Each item In lsbDest.Items
FieldName = FieldName & item & ","
Next
'// ตัดเครื่องหมายคอมม่าตัวท้ายสุดทิ้ง
If Microsoft.VisualBasic.Right(FieldName, 1) = "," Then FieldName = Mid(FieldName, 1, Len(FieldName) - 1)
'// dbfName เป็นตัวแปรแบบ Public บนฟอร์มนี้ (ประกาศไว้บนสุด)
Dim strSQL As String = "SELECT " & FieldName & " FROM [" & dbfName & "]"
txtSQL.Text = strSQL
'//
Cmd = New OleDbCommand(strSQL, Conn)
If Conn.State = ConnectionState.Closed Then Conn.Open()
Dim myDA As OleDbDataAdapter = New OleDbDataAdapter(Cmd)
Dim myDataSet As DataSet = New DataSet()
'// Using DataAdapter object fill data from database into DataSet object
myDA.Fill(myDataSet, "MyTable")
'// Binding DataSet to DataGridView
dgvData.DataSource = myDataSet.Tables("MyTable").DefaultView
lblCount.Text = "[จำนวน: " & Format(Val(dgvData.Rows.Count - 1), "#,##") & " รายการ]"
Conn.Close()
'//
With dgvData
.RowHeadersVisible = False
.AllowUserToAddRows = False
.AllowUserToDeleteRows = False
.AllowUserToResizeRows = False
.MultiSelect = False
.SelectionMode = DataGridViewSelectionMode.FullRowSelect
.ReadOnly = True
' Autosize Column
.AutoSizeColumnsMode = DataGridViewAutoSizeColumnsMode.Fill
.AutoResizeColumns()
.Font = New Font("Tahoma", 8)
'// ตั้งค่า ColumnHeadersHeightSizeMode ก่อนที่จะทำการปรับความสูงของแถวได้
.ColumnHeadersHeightSizeMode = DataGridViewColumnHeadersHeightSizeMode.EnableResizing
.ColumnHeadersHeight = 28
'// กำหนดให้ EnableHeadersVisualStyles = False เพื่อให้ยอมรับการเปลี่ยนแปลงสีพื้นหลัง
.EnableHeadersVisualStyles = False
'// Even-Odd Color
.AlternatingRowsDefaultCellStyle.BackColor = Color.LightYellow ' .AliceBlue
' ตัวอย่างการปรับ Header Style
With .ColumnHeadersDefaultCellStyle
.BackColor = Color.Navy
.ForeColor = Color.Black
.Font = New Font("Tahoma", 8, FontStyle.Bold)
End With
For iCol As Integer = 0 To .Columns.Count - 1
'// คำนวณหาเลขคู่กับเลขคี่ หากเลขจำนวนเต็มใดๆหารเอาเศษ (Mod) ด้วย 2 แล้วได้คำตอบ 1 คือเลขคี่
If iCol Mod 2 = 1 Then
.Columns(iCol).HeaderCell.Style.BackColor = Color.DarkOrange
'// หารเอาเศษด้วย 2 ได้ 0 คือเลขคู่
Else
.Columns(iCol).HeaderCell.Style.BackColor = Color.DeepSkyBlue
End If
Next
End With
Catch ex As Exception
MessageBox.Show(ex.Message, "Open DBF")
Exit Sub
End Try
End Sub
Private Sub lsbSource_DoubleClick(sender As Object, e As System.EventArgs) Handles lsbSource.DoubleClick
'// ยังไม่ได้เลือกไอเทม
If lsbSource.SelectedIndex < 0 Then
MessageBox.Show("กรุณาเลือกไอเทมในรายการที่ 1 ก่อน.", "รายงานสถานะ", MessageBoxButtons.OK, MessageBoxIcon.Information)
Else
'// เพิ่มไอเทมที่เลือกจาก lsbSource ไปให้กับ lsbDest
lsbDest.Items.Add(lsbSource.SelectedItem)
'// ลบไอเทมที่เลือกใน lsbSource ออกไป
lsbSource.Items.Remove(lsbSource.SelectedItem)
End If
End Sub
Private Sub lsbDest_DoubleClick(sender As Object, e As System.EventArgs) Handles lsbDest.DoubleClick
If lsbDest.SelectedIndex < 0 Then
MessageBox.Show("กรุณาเลือกไอเทมในรายการที่ 2 ก่อน.", "รายงานสถานะ", MessageBoxButtons.OK, MessageBoxIcon.Information)
Else
'// เพิ่มไอเทมที่เลือกจาก lsbDest ไปให้กับ lsbSource
lsbSource.Items.Add(lsbDest.SelectedItem)
'// ลบไอเทมที่เลือกใน lsbDest ออกไป
lsbDest.Items.Remove(lsbDest.SelectedItem)
End If
End Sub
Private Sub btnMoveUp_Click(sender As System.Object, e As System.EventArgs) Handles btnMoveUp.Click
'Make sure our item is not the first one on the list.
If lsbDest.SelectedIndex > 0 Then
Dim iRow = lsbDest.SelectedIndex - 1
lsbDest.Items.Insert(iRow, lsbDest.SelectedItem)
lsbDest.Items.RemoveAt(lsbDest.SelectedIndex)
lsbDest.SelectedIndex = iRow
End If
End Sub
Private Sub btnMoveDown_Click(sender As System.Object, e As System.EventArgs) Handles btnMoveDown.Click
'Make sure our item is not the last one on the list.
If lsbDest.SelectedIndex < lsbDest.Items.Count - 1 Then
'Insert places items above the index you supply, since we want
'to move it down the list we have to do + 2
Dim iRow = lsbDest.SelectedIndex + 2
lsbDest.Items.Insert(iRow, lsbDest.SelectedItem)
lsbDest.Items.RemoveAt(lsbDest.SelectedIndex)
lsbDest.SelectedIndex = iRow - 1
End If
End Sub
Private Sub btnClearGrid_Click(sender As System.Object, e As System.EventArgs) Handles btnClearGrid.Click
dgvData.DataSource = Nothing
lblCount.Text = "[จำนวน: 0 รายการ]"
End Sub
Private Sub itemBtnExit_Click(sender As System.Object, e As System.EventArgs) Handles itemBtnExit.Click
Me.Close()
End Sub
Private Sub ToolStripStatusLabel3_Click(sender As System.Object, e As System.EventArgs) Handles ToolStripStatusLabel3.Click
Process.Start("http://www.g2gnet.com/webboard")
End Sub
Private Sub ToolStripStatusLabel2_Click(sender As System.Object, e As System.EventArgs) Handles ToolStripStatusLabel2.Click
Process.Start("https://www.facebook.com/g2gnet")
End Sub
Private Sub itemExportXLS_Click(sender As System.Object, e As System.EventArgs) Handles itemExportXLS.Click
'// ไม่มีข้อมูลในตารางกริด ก็สั่งให้เด้งหนีออกไป
If dgvData.Rows.Count = 0 Then Exit Sub
'// พิจารณาการเลือกใช้ชนิดข้อมูล (Data Type) ให้เหมาะสม
Dim MaxRow As Integer, MaxCol As Short
Dim nRow As Integer, nCol As Short
Dim xlsApp As New Excel.Application
Dim xlsWorkBook As Excel.Workbook = xlsApp.Workbooks.Add
Dim xlsWorkSheet As Excel.Worksheet = CType(xlsWorkBook.Worksheets(1), Excel.Worksheet)
'// S T A R T
Try
xlsApp.Visible = True
'// หาค่าจำนวนแถว
MaxRow = dgvData.RowCount
'// หาค่าจำนวนหลัก
MaxCol = dgvData.Columns.Count - 1
With xlsWorkSheet
.Cells.Select()
.Cells.Delete()
'// Header
For nCol = 0 To MaxCol
.Cells(1, nCol + 1).Value = dgvData.Columns(nCol).HeaderText
Next nCol
'// ไล่ตามจำนวนแถว
For nRow = 0 To MaxRow - 1
For nCol = 0 To MaxCol
.Cells(nRow + 2, nCol + 1).value = dgvData.Rows(nRow).Cells(nCol).Value
Next nCol '// Nested Loop
'// หากชุดคำสั่งที่อยู่ในลูป For มันมีจำนวนเยอะมาก
'// การให้ตัวแปรต่อท้าย Next จะช่วยให้เรารู้ว่ามันอยู่ใน Loop ไหน
Next nRow
'// กำหนดรูปแบบใน WorkSheet
.Rows("1:1").Font.FontStyle = "Bold"
.Rows("1:1").Font.Size = 10
'//
.Cells.Columns.AutoFit()
.Cells.Select()
.Cells.EntireColumn.AutoFit()
.Cells(1, 1).Select()
End With
'//
releaseObject(xlsWorkSheet)
releaseObject(xlsWorkBook)
releaseObject(xlsApp)
Catch ex As Exception
MessageBox.Show(ex.Message, "Error", MessageBoxButtons.OK, MessageBoxIcon.Error)
End Try
xlsWorkSheet = Nothing
xlsWorkBook = Nothing
xlsApp = Nothing
End Sub
' / --------------------------------------------------------------------------------
Private Sub releaseObject(ByVal obj As Object)
Try
System.Runtime.InteropServices.Marshal.ReleaseComObject(obj)
obj = Nothing
Catch ex As Exception
obj = Nothing
MessageBox.Show("Exception Occured while releasing object " + ex.ToString())
Finally
GC.Collect()
End Try
End Sub
Private Sub txtSQL_KeyDown(sender As Object, e As System.Windows.Forms.KeyEventArgs) Handles txtSQL.KeyDown
'// Lock KeyDown
e.SuppressKeyPress = True
End Sub
End Class

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

ดาวน์โหลดโค้ดต้นฉบับ VB.NET (2010) ได้ที่นี่ ...

buree · โพสต์ 2019-5-29 15:19:09

ขอบพระคุุณครับ ท่านอาจารย์

		จำสถานะนี้ไว้ในครั้งหน้า	ลืมรหัสผ่าน
รหัสผ่าน			ลงทะเบียน

[VB.NET] โค้ดการอ่านโครงสร้าง DBase File แล้วเลือกฟิลด์ข้อมูลเพื่อนำมาแสดงผลในตารางกริด

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