Lord_Rat
Feb 2nd, 2003, 12:25 AM
I spent all day trying to make my program create a table dynamically and fix fields if they are not of a type I am expecting.
I couldn't find a case of someone already doing this, so this is an FYI post for any who are looking to do the same thing.
I like to keep my code as easy (for me) to use, so here is how you check a table:
'This code assumes a 'backup' folder exists under the sDataSet location
Dim sDataSet As String = Application.ExecutablePath
sDataSet = sDataSet.Remove(InStrRev(Application.ExecutablePath, "\"), Len(Application.ExecutablePath) - InStrRev(Application.ExecutablePath, "\")) 'defines the folder where the data is
Dim tdTable As New TableDescription()
With tdTable
.PriKey = "PriKey" 'Primary Key field. Can be left blank
.TableName = "Locations" 'Name of table to check
.Fields = MakeArray("Location_Description", "Location_Database") 'field names
.FieldTypes = MakeADOXArray(ADOX.DataTypeEnum.adVarWChar, ADOX.DataTypeEnum.adVarWChar) 'Field types of fields
.MissingIsFatal = MakeBooleanArray(False, False) 'whether to throw an error is a field doesn't match
End With
VerifyDataBase("dataset.mdb", tdTable) 'Now verify the 'dataset.mdb' database
And the TableDescription Class...
Public Class TableDescription
Private TName As String
Private aFields() As String
Private MFatal() As Boolean
Private FTypes() As ADOX.DataTypeEnum
Private PKey As String
Property TableName() As String
Get
Return TName
End Get
Set(ByVal Value As String)
TName = Value
End Set
End Property
Property Fields() As String()
Get
Return aFields
End Get
Set(ByVal Value() As String)
aFields = Value
End Set
End Property
Property MissingIsFatal() As Boolean()
Get
Return MFatal
End Get
Set(ByVal Value() As Boolean)
MFatal = Value
End Set
End Property
Property FieldTypes() As ADOX.DataTypeEnum()
Get
Return FTypes
End Get
Set(ByVal Value() As ADOX.DataTypeEnum)
FTypes = Value
End Set
End Property
Property PriKey() As String
Get
Return PKey
End Get
Set(ByVal Value As String)
PKey = Value
End Set
End Property
End Class
Lord_Rat
Feb 2nd, 2003, 12:25 AM
Due to message length, I had to make two posts:
And the functions:
Private Sub VerifyDataBase(ByVal dbName As String, ByVal tdTable As TableDescription)
Dim objFile As Scripting.File
Dim sDataSet As String = Application.ExecutablePath
Dim sDataSet1 As String = ""
Dim AcApp As New ADOX.Catalog()
Dim oColumn As New ADOX.Column()
Dim objTable As New ADOX.Table()
If tdTable.Fields.GetUpperBound(0) <> tdTable.FieldTypes.GetUpperBound(0) Then
throwError("VerifyDataBase Fields not FieldTypes")
Exit Sub
End If
If tdTable.Fields.GetUpperBound(0) <> tdTable.MissingIsFatal.GetUpperBound(0) Then
throwError("VerifyDataBase Fields not MissingIsFatal")
Exit Sub
End If
sDataSet = sDataSet.Remove(InStrRev(Application.ExecutablePath, "\"), Len(Application.ExecutablePath) - InStrRev(Application.ExecutablePath, "\"))
sDataSet1 = sDataSet & dbName
If Not VerifyDataSource(sDataSet1) Then
'The datasource could not be opened, so we are going to back it up if it exists and recreate it.
If objFS.FileExists(sDataSet1) Then
Try
objFS.CopyFile(sDataSet1, sDataSet & "\backup\" & System.DateTime.Now.ToFileTime().ToString() & ".mdb", True)
Catch
End Try
objFile = objFS.GetFile(sDataSet1)
objFile.Delete(True)
End If
Try
AcApp.Create("Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & sDataSet1)
With objTable
.Name = tdTable.TableName
With .Columns
Dim iCounter As Integer
For iCounter = 0 To tdTable.Fields.GetUpperBound(0)
Select Case tdTable.FieldTypes(iCounter)
Case ADOX.DataTypeEnum.adInteger
.Append(tdTable.Fields(iCounter), tdTable.FieldTypes(iCounter), 255)
Case Else
.Append(tdTable.Fields(iCounter), tdTable.FieldTypes(iCounter))
End Select
Next
End With
End With
AcApp.Tables.Append(objTable)
If tdTable.PriKey <> "" Then
' Create a new AutoNumber ID Column
With oColumn
.Name = tdTable.PriKey
.Type = ADOX.DataTypeEnum.adInteger
.ParentCatalog = AcApp ' Must set before setting properties
.Properties("AutoIncrement").Value = True
End With
AcApp.Tables(tdTable.TableName).Columns.Append(oColumn)
objTable.Keys.Append(tdTable.TableName, ADOX.KeyTypeEnum.adKeyPrimary, tdTable.PriKey)
End If
Catch ee As Exception
throwError(sDataSet1 & vbCrLf & vbCrLf & ee.Message & vbCrLf & vbCrLf & "The file could not be opened. A new one could not be created either.")
MyBase.Dispose()
Exit Sub
End Try
throwError(sDataSet1 & vbCrLf & vbCrLf & "The file could not be opened. A new version has been created.")
Else
'Database exists, so check it to see if the fields are OK
Dim AcConn As New ADODB.Connection()
Dim modsMade As Boolean = False
AcConn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & sDataSet1
AcConn.Open()
AcApp.ActiveConnection = AcConn
Try
objTable = AcApp.Tables(tdTable.TableName)
Catch
objTable = New ADOX.Table()
objTable.Name = tdTable.TableName
AcApp.Tables.Append(objTable)
End Try
Dim objColumn As ADOX.Column
Dim iCount As Integer
Dim bFound() As Boolean
ReDim bFound(tdTable.Fields.GetUpperBound(0) + 1)
For iCount = 0 To tdTable.Fields.GetUpperBound(0)
For Each objColumn In objTable.Columns
With objColumn
If .Name = tdTable.Fields(iCount) AndAlso .Type = tdTable.FieldTypes(iCount) Then
bFound(iCount) = True
Exit For
End If
End With
Next
Next
Dim bFound2 As Boolean
Dim objKey As ADOX.Key
oColumn = New ADOX.Column()
For Each objKey In objTable.Keys
With objKey
If .Columns(0).Name = tdTable.PriKey AndAlso .Type = ADOX.KeyTypeEnum.adKeyPrimary AndAlso objTable.Columns(objKey.Columns(0).Name).Properties("AutoIncrement").Value = True Then
bFound2 = True
Exit For
End If
End With
Next
If Not bFound2 Then
'The datasource could not be opened, so we are going to back it up if it exists and recreate it.
If objFS.FileExists(sDataSet1) Then
Try
objFS.CopyFile(sDataSet1, sDataSet & "\backup\" & System.DateTime.Now.ToFileTime().ToString() & ".mdb", True)
Catch
End Try
modsMade = True
End If
With oColumn
.Name = tdTable.PriKey
.Type = ADOX.DataTypeEnum.adInteger
.ParentCatalog = AcApp ' Must set before setting properties
.Properties("AutoIncrement").Value = True
End With
Try
AcApp.Tables(tdTable.TableName).Columns.Delete(oColumn.Name)
AcApp.Tables.Refresh()
Catch
End Try
AcApp.Tables(tdTable.TableName).Columns.Append(oColumn)
objTable.Keys.Append(tdTable.TableName, ADOX.KeyTypeEnum.adKeyPrimary, tdTable.PriKey)
End If
For iCount = 0 To tdTable.Fields.GetUpperBound(0)
If Not bFound(iCount) Then
If tdTable.MissingIsFatal(iCount) Then
throwError(sDataSet1 & vbCrLf & vbCrLf & "Column " & tdTable.Fields(iCount) & " of type " & tdTable.FieldTypes(iCount) & " not found.")
AcConn.Close()
Exit Sub
Else
'We are changing the data, including deleting a column, so make a backup:
If objFS.FileExists(sDataSet1) AndAlso Not modsMade Then
Try
objFS.CopyFile(sDataSet1, sDataSet & "\backup\" & System.DateTime.Now.ToFileTime().ToString() & ".mdb", True)
Catch
End Try
modsMade = True
End If
Try
AcApp.Tables(tdTable.TableName).Columns.Delete(tdTable.Fields(iCount))
AcApp.Tables.Refresh()
Catch
End Try
Select Case tdTable.FieldTypes(iCount)
Case ADOX.DataTypeEnum.adVarWChar
objTable.Columns.Append(tdTable.Fields(iCount), tdTable.FieldTypes(iCount), 255)
Case Else
objTable.Columns.Append(tdTable.Fields(iCount), tdTable.FieldTypes(iCount))
End Select
End If
End If
Next
AcConn.Close()
End If
End Sub
Private Sub throwError(ByVal inText)
MsgBox(inText)
End Sub
Private Function MakeArray(ByVal ParamArray inObjects() As String) As String()
Return inObjects
End Function
Private Function MakeADOXArray(ByVal ParamArray inObjects() As ADOX.DataTypeEnum) As ADOX.DataTypeEnum()
Return inObjects
End Function
Private Function MakeBooleanArray(ByVal ParamArray inObjects() As Boolean) As Boolean()
Return inObjects
End Function
Private Function VerifyDataSource(ByVal inMDBPath As String) As Boolean
If objFS.FileExists(inMDBPath) Then
objConn = New OleDb.OleDbConnection("Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & _
inMDBPath)
Try
objConn.Open()
Catch
Return False
End Try
Else
Return False
End If
VerifyDataSource = True
End Function
Please recognize the author (me), Keith Ratliff, if you use the code or a majority of the code as-is.