[VB.NET] โค้ดการอ่านโครงสร้าง DBase File แล้วเลือกฟิลด์ข้อมูลเพื่อนำมาแสดงผลในตารางกริด
http://www.g2gnet.com/webboard/images/vbnet/ViewDataDBF.pngDBase 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 ...
http://www.g2gnet.com/webboard/images/vbnet/vfpinstall.png
การ Add Reference MS Excel (แอดมินใช้ Office 2010 หรือ เวอร์ชั่น 14 หากไม่ตรงกับรุ่นของแอดมิน ต้องทำการเลือกเข้ามาใหม่ก่อนครับ)
http://www.g2gnet.com/webboard/images/vbnet/excelref.png
มาดูโค้ดฉบับเต็มกันเถอะ ...
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) ได้ที่นี่ ...
ขอบพระคุุณครับ ท่านอาจารย์
หน้า:
[1]