This is just a small Database Schema Utility Class.
Code:Option Strict On Option Explicit On Imports System.Data.OleDb 'This Code is given freely with no limitations on usage either personal or business. 'Code is provided "As Is" and has no warranties or guarantees associated with it. 'This is designed for versions of access prior to 2007, 2007 or later will need to modify 'at minimum the connection string. Public Class AccessSchemaUtility 'Global OledDBConnection Private globCN As OleDbConnection Protected Friend Function CreateNewConnection(ByVal FileName As String) As Boolean Dim cnStr As String = String.Empty Dim dbloc As String = String.Empty Try 'If the database string stored in setting exists use it 'Else find the database. Once found setting gets changed. If System.IO.File.Exists(FileName) = False Then dbloc = "C:\New Folder\Air Enterprises\AE_Data.mdb" ElseIf System.IO.File.Exists(dbloc) = False AndAlso System.IO.File.Exists(FileName) = False Then 'If file cannot be found then use an open file dialogue to find an appropriate database. Dim ofd As New OpenFileDialog With ofd .CheckFileExists = True .Multiselect = False .DefaultExt = ".mdb" .Filter = "Database Files(*.mdb)|*.mdb" .InitialDirectory = Environment.GetFolderPath(Environment.SpecialFolder.MyDocuments) .Title = "Find Database" .ShowDialog() dbloc = .FileName End With End If 'Setup the connection string cnStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbloc & ";" 'If connection does not exist or is not currently open then create new connection If IsNothing(globCN) = True Then globCN = New OleDbConnection(cnStr) globCN.Open() End If Return True Catch ex As Exception MessageBox.Show(Err.Number & ": " & Err.Description) Return False End Try End Function Protected Friend Function TestConnection(ByVal cn As OleDbConnection) As Boolean 'This is just a simple function to check if your database connection is open Try Select Case cn.State Case ConnectionState.Broken Return False Case ConnectionState.Closed Return False Case ConnectionState.Connecting Return True Case ConnectionState.Executing Return True Case ConnectionState.Fetching Return True Case ConnectionState.Open Return True End Select Catch ex As Exception Return False End Try End Function Protected Friend Sub DisconnectFromDB() Try 'Destroys the connection. If Not IsNothing(globCN) Then globCN.Close() globCN.Dispose() globCN = Nothing End If Catch ex As Exception MessageBox.Show("Error Closing Database Connection " & Err.Number & ": " & Err.Description) End Try End Sub Protected Friend Sub AddColumnToDB(ByVal DBName As String, ByVal TableName As String, ByVal ColumnName As String, ByVal ColumnType As String) Dim cmd As OleDbCommand = Nothing Dim SelStr As String = String.Empty Dim dt As New DataTable Try If CreateNewConnection(DBName) = True Then 'get list of fields in the access table dt = GetAccessTableColumnList(DBName, TableName) 'IF nothing is returned then there was most likely an error and need to exit. If dt Is Nothing Then Throw New Exception("Unable to find Column List for table " & TableName & ".") End If 'Check for the specified field name, if found simply exit sub 'This *IS* Case Sensitive..... For i As Integer = 0 To dt.Rows.Count - 1 If dt.Rows(i).Item(3).ToString = ColumnName Then Exit Sub End If Next 'If it gets to this point then the field is not in the table and needs to be added cmd = New OleDbCommand SelStr = "ALTER Table " & TableName & " ADD COLUMN " & ColumnName & " " & ColumnType cmd.CommandType = CommandType.Text cmd.CommandText = SelStr cmd.Connection = globCN cmd.ExecuteNonQuery() Else MessageBox.Show("Cannot Connect to Database") End If Catch ex As Exception MessageBox.Show("Error Adding Column to Database " & Err.Number & ": " & Err.Description) Finally 'cleanup objects If cmd IsNot Nothing Then cmd.Dispose() If dt IsNot Nothing Then dt.Dispose() 'Close database connection DisconnectFromDB() End Try End Sub Protected Friend Function GetAccessTableList(ByVal DBFile As String) As DataTable Dim dt As New DataTable Try If CreateNewConnection(DBFile) = False Then Return Nothing Else dt = globCN.GetSchema("Tables") Return dt End If Catch ex As Exception MessageBox.Show("Error getting Access Table Schema: " & Err.Number & ": " & Err.Description, "Error Getting Access Table Schema") Return Nothing End Try End Function Protected Friend Function GetAccessTableColumnList(ByVal DBName As String, ByVal TableName As String) As DataTable Try If CreateNewConnection(DBName) = True Then Dim dt_field As DataTable = globCN.GetOleDbSchemaTable( _ OleDb.OleDbSchemaGuid.Columns, _ New Object() {Nothing, Nothing, TableName}) Return dt_field Else Return Nothing End If Catch ex As Exception MessageBox.Show("Error getting Access Table Schema: " & Err.Number & ": " & Err.Description, "Error Getting Access Table Schema") Return Nothing End Try End Function End Class




Reply With Quote