Below is what I've done so far in the Database class.... I have to keep perfecting it. There is allot involved.
Class MatrixDB
'***********************************************
'This class replaces all single quotes (') with a tilda (`) when adding anything to a database,
'when data is retrieved it reverses this process. This is done to keep errors from occuring.
'***********************************************
Public Function LoadDB(strMyDir, strDatabase)
objCon.Open "Provider = Microsoft.ACE.OLEDB.12.0; " & _
"Data Source=" & strMyDir & strDatabase & ";User Id=admin;Password=;"
objDat.ActiveConnection = "Provider = Microsoft.ACE.OLEDB.12.0; " & _
"Data Source=" & strMyDir & strDatabase & ";User Id=admin;Password=;"
End Function
Public Function UnLoadDB()
objCon.Close
End Function
'***********************************************
'***********************************************
Public Function GetAllValues(strTable, strColumn)
e = 0
strTable = Replace(strTable, "'", "`", 1, -1, vbTextCompare)
strColumn = Replace(strColumn, "'", "`", 1, -1, vbTextCompare)
Dim ACols(50)
objRec.Open "SELECT * FROM " & "[" & strTable & "]", objCon, 3, 3
objRec.MoveFirst
Do Until objRec.EOF
e = e + 1
Name = objRec.Fields.Item(strColumn)
Name = Replace(Name, "`", "'", 1, -1, vbTextCompare)
ACols(e) = Name
objRec.MoveNext
Loop
objRec.close
GetAllValues = ACols
End Function
'***********************************************
'***********************************************
Public Function GetSelectValues(strTable, strColumn, strColumnCompare, strValueCompare)
e = 0
strTable = Replace(strTable, "'", "`", 1, -1, vbTextCompare)
strColumn = Replace(strColumn, "'", "`", 1, -1, vbTextCompare)
strColumnCompare = Replace(strColumnCompare, "'", "`", 1, -1, vbTextCompare)
strValueCompare = Replace(strValueCompare, "'", "`", 1, -1, vbTextCompare)
Dim ACols(50)
objRec.Open "SELECT * FROM " & "[" & strTable & "]", objCon, 3, 3
Do Until objRec.EOF
On Error Resume Next
Name = objRec.Fields.Item(strColumnCompare)
Name2 = objRec.Fields.Item(strColumn)
objRec.MoveNext
If Name = strValueCompare Then
e = e + 1
Name2 = Replace(Name2, "`", "'", 1, -1, vbTextCompare)
ACols(e) = Name2
End If
Loop
objRec.close
GetSelectValues = ACols
End Function
'***********************************************
'***********************************************
Public Function GetAllColumns(strMyDir, strDatabase, strTable)
e = 0
strTable = Replace(strTable, "'", "`", 1, -1, vbTextCompare)
UnLoadDB
LoadDB strMyDir, strDatabase
Dim Acols(50)
For Each objTable In objDat.Tables
If ObjTable.Name = strTable And ObjTable.Type = "TABLE" Then
For Each objColumn in objTable.Columns
e = e + 1
Name = Replace(objColumn.Name, "`", "'", 1, -1, vbTextCompare)
Acols(e) = Name
Next
End If
Next
GetAllColumns = Acols
End Function
'***********************************************
'***********************************************
Public Function CheckColumnExists(strMyDir, strDatabase, strTable, strColumn)
e = 0
strTable = Replace(strTable, "'", "`", 1, -1, vbTextCompare)
strColumn = Replace(strColumn, "'", "`", 1, -1, vbTextCompare)
ACols = GetAllColumns(strMyDir, strDatabase, strTable)
For Each Column In ACols
If Column = strColumn Then
e = e + 1
End If
Next
If e > 0 Then
CheckColumnExists = e
Else
CheckColumnExists = 0
End If
End Function
'***********************************************
'***********************************************
Public Function CheckValueExists(strTable, strColumn, strValue)
e = 0
strTable = Replace(strTable, "'", "`", 1, -1, vbTextCompare)
strColumn = Replace(strColumn, "'", "`", 1, -1, vbTextCompare)
strValue = Replace(strValue, "'", "`", 1, -1, vbTextCompare)
objRec.Open "SELECT * FROM " & "[" & strTable & "]", objCon, 3, 3
Do Until objRec.EOF
Name = objRec.Fields.Item(strColumn)
If InStr(1, Name, strValue, vbTextCompare) > 0 Or Name = strValue Then
e = e + 1
End If
objRec.MoveNext
Loop
objRec.close
If e > 0 Then
CheckValueExists = e
Else
CheckValueExists = 0
End If
End Function
'***********************************************
'***********************************************
Public Sub CreateColumn(strTable, strColumnName, DataType)
strTable = Replace(strTable, "'", "`", 1, -1, vbTextCompare)
strColumnName = Replace(strColumnName, "'", "`", 1, -1, vbTextCompare)
objCon.Execute "ALTER TABLE [" & strTable & "] ADD [" & strColumnName & "] " & DataType & " NULL"
End Sub
'***********************************************
'***********************************************
Public Sub UpDateSelectValues(strTable, strColumn, strValueAdd, strColumnCompare, strValueCompare)
strTable = Replace(strTable, "'", "`", 1, -1, vbTextCompare)
strColumn = Replace(strColumn, "'", "`", 1, -1, vbTextCompare)
strValueAdd = Replace(strValueAdd, "'", "`", 1, -1, vbTextCompare)
strColumnCompare = Replace(strColumnCompare, "'", "`", 1, -1, vbTextCompare)
strValueCompare = Replace(strValueCompare, "'", "`", 1, -1, vbTextCompare)
objCon.Execute "UPDATE [" & strTable & "] SET [" & strColumn & "] = " & "'" & strValueAdd & "'" & _
" WHERE [" & strColumnCompare & "] = " & "'" & strValueCompare & "'"
End Sub
'***********************************************
'***********************************************
Public Sub UpDateAllValues(strTable, strColumn, strValueAdd)
strTable = Replace(strTable, "'", "`", 1, -1, vbTextCompare)
strColumn = Replace(strColumn, "'", "`", 1, -1, vbTextCompare)
strValueAdd = Replace(strValueAdd, "'", "`", 1, -1, vbTextCompare)
objCon.Execute "UPDATE [" & strTable & "] SET [" & strColumn & "] = " & "'" & strValueAdd & "'"
End Sub
'***********************************************
'***********************************************
Public Sub AddNewTable(strTableName, strNewColumn)
strTableName = Replace(strTableName, "'", "`", 1, -1, vbTextCompare)
strNewColumn = Replace(strNewColumn, "'", "`", 1, -1, vbTextCompare)
objTab.Name = strTableName
objTab.Columns.Append strNewColumn, 3
objDat.Tables.Append objTab
End Sub
'***********************************************
'***********************************************
Public Sub AddValue(strTable, strColumn, strValueAdd)
strTable = Replace(strTable, "'", "`", 1, -1, vbTextCompare)
strColumn = Replace(strColumn, "'", "`", 1, -1, vbTextCompare)
strValueAdd = Replace(strValueAdd, "'", "`", 1, -1, vbTextCompare)
objCon.Execute "INSERT INTO " & "[" & strTable & "]" & " (" & "[" & strColumn & "]" & _
") VALUES (" & "'" & strValueAdd & "'" & ")"
End Sub
'***********************************************
'***********************************************
Public Sub AppendSelectValues(strTable, strColumn, strValueAppend, strColumnCompare, strValueCompare)
strTable = Replace(strTable, "'", "`", 1, -1, vbTextCompare)
strColumn = Replace(strColumn, "'", "`", 1, -1, vbTextCompare)
strValueAppend = Replace(strValueAppend, "'", "`", 1, -1, vbTextCompare)
strColumnCompare = Replace(strColumnCompare, "'", "`", 1, -1, vbTextCompare)
strValueCompare = Replace(strValueCompare, "'", "`", 1, -1, vbTextCompare)
s = 0
ACols = GetSelectValues(strTable, strColumn, strColumnCompare, strValueCompare)
objRec.Open "SELECT * FROM " & "[" & strTable & "]", objCon, 3, 3
For Each strValue1 In ACols
strValue = strValue1 & strValueAppend
If Len(strValue) > Len(strValueAppend) Then
On Error Resume Next
objCon.Execute "UPDATE [" & strTable & "] SET [" & strColumn & "] = " & "'" & strValue & "'" & _
" WHERE [" & strColumnCompare & "] = " & "'" & strValueCompare & "'"
s = s + 1
End If
Next
If s = 0 Then
UpDateSelectValues strTable, strColumn, strValueAppend, strColumnCompare, strValueCompare
End If
objRec.Close
End Sub
Private Sub Class_Initialize()
End Sub
'***********************************************
'***********************************************
Private Sub Class_Terminate()
End Sub
End Class