[VB.NET] แจกฟรีโค้ดการสร้างไฟล์ MS Access ด้วย ADOX พร้อมกับการสร้าง และลบตารางข้อมูล

thongkorn · โพสต์ 2018-9-24 11:12:06

แอดมินไปเดินส่องตำราต่างๆของการเขียนโปรแกรมในภาคภาษาไทย ล้วนแล้วแต่มักสอนให้เก็บข้อมูลลงในระดับ File Server เช่น MSSQL หรือ MySQL โดยส่วนตัวแอดมินคิดว่ามันใหญ่โตเกินไป ไม่เหมาะกับผู้ที่พึ่งจะเรียนรู้การเขียนโปรแกรม หรือการทำโปรเจคขนาดเล็กๆไปถึงขนาดกลาง ที่มีการเคลื่อนไหวของข้อมูลไม่มากสักเท่าไหร่ รวมไปถึงการติดตั้งที่ยุ่งยากอีกต่างหาก ดังนั้นระดับ File Base เช่น MS Access จึงเป็นหนึ่งทางเลือกที่เรานำมาใช้งาน วันนี้แอดมินจะมาขอนำเสนอ การสร้างไฟล์ MS Access ขึ้นมาด้วยการติดต่อกับ ADOX (ADO Extend) ซึ่งเราได้ใช้กันมาตั้งแต่ยุคสมัย VB6 แล้วครับ มาบัดนี้จะเอามันมาใช้ประโยชน์บน VB.NET ... แอ่นแอ๊นนนนน

เลือก Reference --> COM ... Microsoft ADO Ext. for DLL and Security แบบ TypeLib ...

มาดูโค้ดกันเถอะ ... โค้ดอาจจะดูรกๆไปสักกะหน่อย ก็เพราะแอดมินเจตนาแยกให้เห็นวิธีการทำงานของโค้ดในแต่ละส่วน และยังไม่ได้ใส่โค้ดในการเช็คว่ามีชื่อตาราง หรือชื่อฟิลด์อยู่แล้วหรือไม่ เอาไว้รอบหน้าล่ะกันครับ

' / --------------------------------------------------------------------------------
' / Developer : Mr.Surapon Yodsanga (Thongkorn Tubtimkrob)
' / eMail : thongkorn@hotmail.com
' / URL: http://www.g2gnet.com (Khon Kaen - Thailand)
' / Facebook: https://www.facebook.com/g2gnet (For Thailand)
' / Facebook: https://www.facebook.com/commonindy (Worldwide)
' / Purpose: Create MS Access DataBase with VB.NET
' / Microsoft Visual Basic .NET (2010) + MS ACCESS 2003+
' /
' / This is open source code under @CopyLeft by Thongkorn Tubtimkrob.
' / You can modify and/or distribute without to inform the developer.
' / --------------------------------------------------------------------------------
Public Class frmCreateDataBase
' / --------------------------------------------------------------------------------
Private Sub btnCreateDB_Click(sender As System.Object, e As System.EventArgs) Handles btnCreateDB.Click
Dim strPathData As String = MyPath(Application.StartupPath) & "Sample.accdb"
'/ Check the Filename.
If Not System.IO.File.Exists(strPathData) Then
'// No database files. So it must be rebuilt.
If CreateAccessDataBase(strPathData) Then
If CreateTable(strPathData, "tblSample") Then
MessageBox.Show("DataBase & Table has successfull created.", "Report Status", MessageBoxButtons.OK, MessageBoxIcon.Information)
Call InitializeGrid()
'// Create Sample data.
Call FillData(strPathData, "tblSample")
End If
End If
'// File already exist.
Else
MessageBox.Show("The database file already exists.", "Report Status", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
'// You can delete the table and recreate again.
Call DropTable(strPathData, "tblSample") '// Ignore Error.
If CreateTable(strPathData, "tblSample") Then
MessageBox.Show("Table has successfull created.", "Report Status", MessageBoxButtons.OK, MessageBoxIcon.Information)
Call InitializeGrid()
'// Create Sample data.
Call FillData(strPathData, "tblSample")
End If
End If
End Sub
' / --------------------------------------------------------------------------------
' / CREATE FILE MS ACCESS.
Public Function CreateAccessDataBase(ByVal DatabaseFullPath As String) As Boolean
CreateAccessDataBase = False
Dim MyCatalog As New ADOX.Catalog()
Try
Dim sCreateString As String
sCreateString = ("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & DatabaseFullPath)
MyCatalog.Create(sCreateString)
'MessageBox.Show("DataBase Created.", "Report Status", MessageBoxButtons.OK, MessageBoxIcon.Information)
MyCatalog = Nothing
CreateAccessDataBase = True
Catch ex As System.Runtime.InteropServices.COMException
CreateAccessDataBase = False
MessageBox.Show(ex.Message, "Report Status", MessageBoxButtons.OK, MessageBoxIcon.Error)
End Try
'//
End Function
' / --------------------------------------------------------------------------------
' / CREATE TABLE.
Public Function CreateTable(ByVal DatabaseFullPath As String, ByVal TableName As String) As Boolean
CreateTable = False
Dim strCreate As String = _
"CREATE TABLE " & TableName & "(" & _
"PK Long," & _
"ID VarChar(25)," & _
"NumberField Integer," & _
"CurrencyField Currency," & _
"DateField Date," & _
"BooleanField YesNo" & _
");"
Try
'// Create the empty table in the DB file
Dim Conn As New OleDb.OleDbConnection("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & DatabaseFullPath & ";Persist Security Info=True")
If Conn.State = ConnectionState.Closed Then Conn.Open()
Dim Cmd As New OleDb.OleDbCommand(strCreate, Conn)
Cmd.ExecuteNonQuery()
'MessageBox.Show("Table Created.", "Report Status", MessageBoxButtons.OK, MessageBoxIcon.Information)
Cmd.Dispose()
Conn.Close()
CreateTable = True
Catch ex As Exception
MessageBox.Show(ex.Message, "Report Status", MessageBoxButtons.OK, MessageBoxIcon.Error)
CreateTable = False
End Try
End Function
' / --------------------------------------------------------------------------------
' / DROP TABLE
Public Function DropTable(ByVal DatabaseFullPath As String, ByVal TableName As String) As Boolean
Dim strDrop As String = "DROP TABLE " & TableName
Dim Conn As New OleDb.OleDbConnection("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & DatabaseFullPath & ";Persist Security Info=True")
If Conn.State = ConnectionState.Closed Then Conn.Open()
Dim Cmd As New OleDb.OleDbCommand(strDrop, Conn)
Try
Cmd.ExecuteNonQuery()
Cmd.Dispose()
Conn.Close()
Return True
Catch ex As Exception
MessageBox.Show(ex.Message, "Report Status", MessageBoxButtons.OK, MessageBoxIcon.Error)
Return False
End Try
End Function
' / --------------------------------------------------------------------------------
' / SAMPLE DATA.
Private Sub FillData(ByVal DatabaseFullPath As String, ByVal TableName As String)
Dim DT As New DataTable
DT.Columns.Add("PK")
DT.Columns.Add("ID")
DT.Columns.Add("NumberField")
DT.Columns.Add("CurrencyField")
DT.Columns.Add("DateField")
DT.Columns.Add("BooleanField")
Dim RandomClass As New Random()
Dim DR As DataRow = DT.NewRow()
For i As Long = 0 To 19
DR = DT.NewRow()
DR(0) = i + 1
DR(1) = "ID" & i + 1
DR(2) = RandomClass.Next(1, 99999)
DR(3) = FormatNumber(RandomClass.Next(100, 1000) + RandomClass.NextDouble(), 2)
'// Random Date.
Dim d As Date = Date.Today
d = d.AddDays(RandomClass.Next(-30, 0))
DR(4) = FormatDateTime(d, DateFormat.ShortDate).ToString
'// Random Boolean.
DR(5) = RandomClass.Next(0, 2) > 0
DT.Rows.Add(DR)
Next
DataGridView1.DataSource = DT
Label1.Text = "Total : " & DT.Rows.Count.ToString("#,##") & " Records."
'// INSERT DATA FROM DATATABLE INTO MS ACCESS.
Try
Dim strConn As String = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & DatabaseFullPath & ";Persist Security Info=True"
Dim Conn As New OleDb.OleDbConnection(strConn)
Dim SQLStmt As String = "DELETE * FROM " & TableName
Dim Cmd As New OleDb.OleDbCommand
'// DELETE ALL PREVIOUS RECORDS.
If Conn.State = ConnectionState.Closed Then Conn.Open()
Cmd = New OleDb.OleDbCommand(SQLStmt, Conn)
Cmd.ExecuteNonQuery()
Cmd.Dispose()
'//
SQLStmt = "SELECT PK, ID, NumberField, CurrencyField, DateField, BooleanField FROM " & TableName
Dim DA As New OleDb.OleDbDataAdapter(SQLStmt, Conn)
Dim CB = New OleDb.OleDbCommandBuilder(DA)
DA.Update(DT)
MessageBox.Show("Create sample data successfull.", "Report Status", MessageBoxButtons.OK, MessageBoxIcon.Information)
CB.Dispose()
DA.Dispose()
DT.Dispose()
Conn.Close()
Catch ex As Exception
MessageBox.Show(ex.Message)
End Try
End Sub
' / --------------------------------------------------------------------------------
'// Initialize DataGridView @Run Time
Private Sub InitializeGrid()
With DataGridView1
.RowHeadersVisible = False
.AllowUserToAddRows = False
.AllowUserToDeleteRows = False
.AllowUserToResizeRows = False
.MultiSelect = False
.SelectionMode = DataGridViewSelectionMode.FullRowSelect
.ReadOnly = True
.Font = New Font("Tahoma", 9)
'/ Autosize Columns.
.AutoSizeColumnsMode = DataGridViewAutoSizeColumnsMode.Fill
.AutoResizeColumns()
'/ Adjust Header Styles
With .ColumnHeadersDefaultCellStyle
.BackColor = Color.Navy
.ForeColor = Color.White
.Font = New Font("Tahoma", 9, FontStyle.Bold)
End With
End With
End Sub
' / --------------------------------------------------------------------------------
' / Get my project path
' / AppPath = C:\My Project\bin\debug
' / Replace "\bin\debug" with ""
' / Return : C:\My Project\
Function MyPath(ByVal 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", "").Replace("\bin\x86\release", "")
'// If not found folder then put the \ (BackSlash) at the end.
If Microsoft.VisualBasic.Right(MyPath, 1) <> "" Then MyPath = MyPath & ""
End Function
Private Sub frmCreateDataBase_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
Label1.Text = ""
End Sub
Private Sub btnExit_Click(sender As System.Object, e As System.EventArgs) Handles btnExit.Click
Me.Close()
End Sub
Private Sub frmCreateDataBase_FormClosed(sender As Object, e As System.Windows.Forms.FormClosedEventArgs) Handles Me.FormClosed
Me.Dispose()
Application.Exit()
End Sub
End Class

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

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

g2gsoftuser · โพสต์ 2022-10-25 20:07:21

ขอบคุณครับ

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

[VB.NET] แจกฟรีโค้ดการสร้างไฟล์ MS Access ด้วย ADOX พร้อมกับการสร้าง และลบตารางข้อมูล

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