Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

A Table manipulation Class

Misc

A Table manipulation Class

by  redapples  Posted    (Edited  )
I constructed this while involved in some analysis of data that required me to make a lot of changes to tables and queries in Access. I found I was doing the same tasks over and over. Mean while I was getting to grips with using ClassModules in Access. I devised this as I found it saved me a lot of time in development. There are some areas where this is not quite as effective as I would like but as I add to it I'll try to update. Suggestions for ammendments will be warmly recieved and credited.

Code: 
Option Compare Database
Option Explicit

'########################################################################
'                       TabMaker
'                       clsTableViewMech
'########################################################################
'Created by:    sconnell
'Created on:    16/05/2005/09:36
'Purpose:       Function/Boolean/
'ADO - makes a table needs connection:cnn, table name:tName, field list:fList
'flist must follow this format "name datatype,..."  There might be a better way
'having an array of names and data types
Public Function TabMaker(cnn As ADODB.Connection, tName As String, fList As String) As Boolean
On Error GoTo TabMaker_Err
    cnn.Execute "CREATE TABLE [" & tName & "] (" & fList & ");"
    TabMaker = True
Exit Function
TabMaker_Err:
    Select Case Err.Number
        Case Else
            TabMaker = False
    End Select
End Function

'########################################################################
'                       TabDropper
'                       clsTableViewMech
'########################################################################
'Created by:    sconnell
'Created on:    16/05/2005/09:39
'Purpose:       Function/Boolean/
'Removes a table from a database
'Requires a connection:cnn, table name:tName
'could be a remote DB
Public Function TabDropper(cnn As ADODB.Connection, tName As String) As Boolean
On Error GoTo TabDropper_Err
    cnn.Execute "DROP TABLE [" & tName & "]"
    TabDropper = True
Exit Function
TabDropper_Err:
    Select Case Err.Number
        Case Else
            TabDropper = False
    End Select
End Function

'########################################################################
'                       TabReseed
'                       clsTableViewMech
'########################################################################
'Created by:    sconnell
'Created on:    16/05/2005/09:41
'Purpose:       Function/Boolean/
'ADO reseed a table: requires connection:cnn, table name:tname, Name of identity field:fname
'Optional the seed for the table:iseed, the interval for autonumber:iInterval
'If Iseed is missing then seed = 0 interval =1
Public Function TabReseed(cnn As Connection, tName As String, fName As String, Optional iSeed As Integer, Optional iInterval As Integer) As Boolean
    Dim str As String
    
    If IsMissing(iSeed) Then
        iSeed = 0
        iInterval = 1
    End If
On Error GoTo TabReseed_Err
    str = "ALTER TABLE [" & tName & "]" & _
          " ALTER COLUMN [" & fName & "]" & _
          " COUNTER(" & iSeed & "," & iInterval & ")"
    cnn.Execute str
    TabReseed = True
Exit Function
TabReseed_Err:
    Select Case Err.Number
        Case Else
            TabReseed = False
    End Select
End Function


'########################################################################
'                       DeleteFrom
'                       clsTableViewMech
'########################################################################
'Created by:    sconnell
'Created on:    16/05/2005/09:47
'Purpose:       Function/Variant/
'NO INTERNAL ERROR HANDLER: throws error
'requires Connection:cnn, table name:tname
'Optional The field to filter:sWherefield, The Comparison:sWhereComparison
'Only accepts one where expresion = flaw
Public Function DeleteFrom(cnn As ADODB.Connection, tName As String, Optional sWhereField As String, Optional sWhereComparison As String) As Variant
    Dim str As String

    str = "DELETE * FROM " & tName
    
    If Not IsMissing(sWhereField) Then
        If Not IsMissing(sWhereComparison) Then
           str = str & " WHERE((([" & sWhereField & "]) = " & sWhereComparison & "));"
        Else
            
            Err.Raise 513, "Class clsTableViewMech DeleteFrom", "A Where Field was supplied with no corrsponding Comparison provided"
                      
        End If
    Else
        str = str & ";"
        cnn.Execute str
    End If
    DeleteFrom = True
End Function
'########################################################################
'                       ViewDropper
'                       clsTableViewMech
'########################################################################
'Created by:    sconnell
'Created on:    16/05/2005/09:52
'Purpose:       Function/Boolean/
'requires connection:cnn and view name:vname
'same as table dropper only for queries
Public Function ViewDropper(cnn As ADODB.Connection, vName As String) As Boolean
On Error GoTo ViewDropper_Err
    cnn.Execute "DROP VIEW [" & vName & "]"
    ViewDropper = True
Exit Function
ViewDropper_Err:
    Select Case Err.Number
        Case Else
            ViewDropper = False
    End Select
End Function

'########################################################################
'                       ViewMaker
'                       clsTableViewMech
'########################################################################
'Created by:    sconnell
'Created on:    16/05/2005/09:54
'Purpose:       Function/Boolean/
'Requires connection:cnn, view name:vName, a Select Query in the form of a string:sSELECT
'Only seems to work with Select Queries. e.g. Will not work with TRANSFORM ... PIVOT queries
'DAO - could be used for these other queries
Public Function ViewMaker(cnn As ADODB.Connection, vName As String, sSELECT As String) As Boolean
On Error GoTo ViewMaker_Err
    cnn.Execute "CREATE VIEW [" & vName & "] AS " & sSELECT
    ViewMaker = True
Exit Function
ViewMaker_Err:
    Select Case Err.Number
        Case Else
            ViewMaker = False
    End Select
End Function

'########################################################################
'                       AddToTab
'                       clsTableViewMech
'########################################################################
'Created by:    sconnell
'Created on:    16/05/2005/09:58
'Purpose:       Function/Boolean/
'Add a new record to an exixsting table
'NO ERR HANDLE: Some custom err throwing built into Select statement
'Requires: Adodb.recordset:rs, an array of the fields to have values added to:FieldList,values
'listed one at a time forming an array to be added.  NB! the values are assigned in the order that they are
'listed so value 1 will be assigned to FieldList(0)
Public Function AddToTab(rs As ADODB.Recordset, FieldList() As Variant, ParamArray ValueList() As Variant) As Boolean
    If UBound(FieldList) = UBound(ValueList) Then
        rs.AddNew FieldList, ValueList
    ElseIf UBound(FieldList) > UBound(ValueList) Then
        Err.Raise 101, "Class clsTableViewMech AddToTab", "Too few values supplied to add"
    Else
        Err.Raise 101, "Class clsTableViewMech AddToTab", "Too many values supplied to add"
    End If
    AddToTab = True
End Function

'########################################################################
'                       DropEachTab
'                       clsTableViewMech
'########################################################################
'Created by:    sconnell
'Created on:    16/05/2005/10:08
'Purpose:       Sub//
'requires a connection:cnn, a list of names of tables to be deleted:vnames
'Can be used for an external DB if needed
'
Public Sub DropEachTab(cnn As ADODB.Connection, ParamArray vNames() As Variant)
    Dim tables As Variant
    Dim str As String
On Error GoTo DropEach_Err
    cnn.BeginTrans
    For Each tables In vNames
        str = "DROP TABLE " & tables
        cnn.Execute str
    Next tables
        cnn.CommitTrans
Exit Sub
DropEach_Err:
    Select Case Err.Number
        Case Else
            cnn.RollbackTrans
            Err.Raise 513, "Class clsTableViewMech DropEach", "A Error Occured Deleting a table"
    End Select
End Sub

'########################################################################
'                       DeleteFromEach
'                       clsTableViewMech
'########################################################################
'Created by:    sconnell
'Created on:    16/05/2005/10:10
'Purpose:       Sub//
'required a connection:cnn, a list of tables to delete records from
'This can only be used to delete all values. For selective deletion it is very complicated
'to do it this way. Seems better to do it table at a time
Public Sub DeleteFromEach(cnn As ADODB.Connection, ParamArray vTables() As Variant)
    Dim tables As Variant
    Dim str As String
On Error GoTo DeleteFromEach_Err
    cnn.BeginTrans
    For Each tables In vTables
        str = "Delete * FROM " & tables & " ;"
        cnn.Execute str
    Next tables
    cnn.CommitTrans

Exit Sub
DeleteFromEach_Err:
    Select Case Err.Number
        Case Else
            cnn.RollbackTrans
            Err.Raise 513, "Class clsTableViewMech DropEach", "A Error Occured Deleting From a table"
    End Select
End Sub

'########################################################################
'                       UpdateTab
'                       clsTableViewMech
'########################################################################
'Created by:    sconnell
'Created on:    16/05/2005/10:14
'Purpose:       Function/Boolean/
'NO ERROR HANDLER- Throws a custom error
'Updates field(s) of a table requires connection:cnn, table nbame:tname, fields to be updated:arVals(), values to update:arvals()
'Optional a Where Clause:strwhere
'Returns an error if the number of fields and values do not match
'Update values are assigned to fields sequentially
Function UpdateTab(cnn As ADODB.Connection, tbName As String, arFields As Variant, arVals As Variant, Optional strWhere) As Boolean
    Dim strSQL As String
    Dim StrChange
    Dim i As Integer
    
    If UBound(arFields) <> UBound(arVals) Then
        Err.Raise 513, "Class clsTableViewMech UpdateTab", "The number of fields and values do not match"
    End If
    
    strSQL = "Update " & tbName & " SET "
    For i = 0 To UBound(arFields)
        StrChange = arFields(i) & " = " & arVals(i) & " ,"
        strSQL = strSQL & StrChange
    Next i
    
    If Not IsMissing(strWhere) Then
        strSQL = Left(strSQL, Len(strSQL) - 1) & strWhere & ";"
    Else
        strSQL = Left(strSQL, Len(strSQL) - 1) & ";"
    End If
    
    cnn.Execute strSQL
    UpdateTab = True
End Function

I use this as a Class_Module and as such it must be instantiated to be used. An advantage to this is all of the methods can be typed using autocomplete.

To delcare this and assign values to it use the following (assumes ClassModule named clsTableViewMech)

Code: 
Dim TVM as New clsTableViewMech
Dim pcnn as ADODB.Connection

Set pcnn = CurrentProject.Connection
'Methods can be called thus
If NOT TVM.TabMaker (pCnn, "projects", "PKey int IDENTITY(1,1) PRIMARY KEY,ProName VarChar(150), ProCode Varchar(5)") then
' do something to record failure
End if
Register to add this FAQ to your archive
Register to rate this FAQ  : BAD 1 2 3 4 5 6 7 8 9 10 GOOD
Please Note: 1 is Bad, 10 is Good :-)

Part and Inventory Search

Back
Top