DEVelopers HUT

'---------------------------------------------------------------------------------------
' Procedure : DoesTblFieldExist
' Author    : CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Determine if a field exists with the specified table
' Copyright : The following may be altered and reused as you wish so long as the
'             copyright notice is left unchanged (including Author, Website and
'             Copyright).  It may not be sold/resold or reposted on other sites (links
'             back to this site are allowed).
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sTableName: Name of the table to check the existance of the field in
' sFieldName: Name of the field to check the existance of
'
' Usage Example:
' ~~~~~~~~~~~~~~~~
' DoesTblFieldExist("Table1","Field1")
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2010-Feb-02             Initial Release
'---------------------------------------------------------------------------------------
Function DoesTblFieldExist(sTableName As String, sFieldName As String) As Boolean
   Dim db            As DAO.Database
   Dim tdf           As TableDef
   Dim I             As String
   Dim bTableExists  As Boolean
 
On Error GoTo Error_Handler
   'Initialize our variables
   DoesTblFieldExist = False
   bTableExists = False
 
   Set db = CurrentDb()
   Set tdf = db.TableDefs(sTableName)
 
   bTableExists = True  'If we made it to here without triggering an error
                        'the table exists
  
   I = tdf.Fields(sFieldName).Name
 
   DoesTblFieldExist = True   'If we made it to here without triggering an
                              'error the table field exists

Error_Handler_Exit:
   On Error Resume Next
   Set tdf = Nothing
   Set db = Nothing
   Exit Function
 
Error_Handler:
   If Err.Number = 3265 And bTableExists = False Then
      'Table not found in the current database
      MsgBox "The specified Table could not be found in the current database", vbCritical
   ElseIf Err.Number = 3265 And bTableExists = True Then
      'Field not found in the specified table
     
   Else
      MsgBox "MS Access has generated the following error" & vbCrLf & vbCrLf & "Error Number: " & _
      Err.Number & vbCrLf & "Error Source: DoesTblFieldExist" & vbCrLf & "Error Description: " & _
      Err.Description, vbCritical, "An Error has Occured!"
   End If
   Resume Error_Handler_Exit
End Function

'---------------------------------------------------------------------------------------
' Procedure : DoesTblExist
' Author    : CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Determine if the specified table exists or not in the current database
' Copyright : The following may be altered and reused as you wish so long as the
'             copyright notice is left unchanged (including Author, Website and
'             Copyright).  It may not be sold/resold or reposted on other sites (links
'             back to this site are allowed).
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sTableName: Name of the table to check the existance of
'
' Usage Example:
' ~~~~~~~~~~~~~~~~
' DoesTblExist("Table1")
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2010-Feb-02             Initial Release
'---------------------------------------------------------------------------------------
Function DoesTblExist(sTableName As String) As Boolean
   Dim db   As DAO.Database
   Dim tdf  As TableDef
 
On Error GoTo Error_Handler
   'Initialize our variable
   DoesTblExist = False
 
   Set db = CurrentDb()
   Set tdf = db.TableDefs(sTableName)
 
   DoesTblExist = True  'If we made it to here without triggering an error
                        'the table exists

Error_Handler_Exit:
   On Error Resume Next
   Set tdf = Nothing
   Set db = Nothing
   Exit Function
 
Error_Handler:
   If Err.Number = 3265 Then
      'If we are here it is because the table could not be found
   Else
      MsgBox "MS Access has generated the following error" & vbCrLf & vbCrLf & "Error Number: " & _
      Err.Number & vbCrLf & "Error Source: DoesTblExist" & vbCrLf & "Error Description: " & _
      Err.Description, vbCritical, "An Error has Occured!"
   End If
   Resume Error_Handler_Exit
End Function

'---------------------------------------------------------------------------------------
' Procedure : ImportAllTbls
' Author    : CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Import all the tables from an external Access database
' Copyright : The following may be altered and reused as you wish so long as the
'             copyright notice is left unchanged (including Author, Website and
'             Copyright).  It may not be sold/resold or reposted on other sites (links
'             back to this site are allowed).
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sExtDbPath - Full Path & Filename of the Database to import the tables from
'
' Usage Example:
' ~~~~~~~~~~~~~~~~
' ImportAllTbls "C:\Databases\development01.mdb"
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2009-Jan-07                 Initial Release
'---------------------------------------------------------------------------------------
Sub ImportAllTbls(sExtDbPath As String)
On Error GoTo Error_Handler
    Dim db      As DAO.Database
    Dim tdf     As DAO.TableDef
 
    Set db = OpenDatabase(sExtDbPath)
 
    For Each tdf In db.TableDefs 'Loop through all the table in the external database
        If Left(tdf.Name, 4) <> "MSys" Then 'Exclude System Tables
            On Error Resume Next
            Access.DoCmd.TransferDatabase acImport, "Microsoft Access", sExtDbPath, _
                                          acTable, tdf.Name, tdf.Name, False
        End If
    Next tdf
    db.Close
 
    Set db = Nothing 'Cleanup after ourselves

Exit Sub
 
Error_Handler:
    MsgBox "MS Access has generated the following error" & vbCrLf & vbCrLf & "Error Number: " & _
    Err.Number & vbCrLf & "Error Source: ImportAllTbls" & vbCrLf & "Error Description: " & _
    Err.Description, vbCritical, "An Error has Occured!"
    Exit Sub
End Sub

'---------------------------------------------------------------------------------------
' Procedure : findmaketbl
' Author    : CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Locate which Make-Table Query is creating a table
' Copyright : The following may be altered and reused as you wish so long as the
'             copyright notice is left unchanged (including Author, Website and
'             Copyright).  It may not be sold/resold or reposted on other sites (links
'             back to this site are allowed).
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sTableName    Name of the Table that you believe is created by a Make-Table Query.
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
'
**************************************************************************************
' 1         2009-Jun-12                 Initial Release
'---------------------------------------------------------------------------------------
Function findmaketbl(sTableName As String)
On Error GoTo Error_Handler
 
    Dim db      As DAO.Database
    Dim qdf     As DAO.QueryDef
    Dim sSQL    As String
 
    Set db = CurrentDb
 
    For Each qdf In db.QueryDefs
        'qdf.Name    'The current query's name
        'qdf.SQL     'The current query's SQL statement
        sSQL = qdf.SQL
        If InStr(sSQL, " INTO ") And InStr(sSQL, sTableName) Then
            'The Query is a Make Table Query and has our TableName we are looking for
            MsgBox "Query:'" & qdf.Name & "' is a Make-Table Query for Table '" & _
                    sTableName & "'.", vbInformation
        End If
    Next
 
    Set qdf = Nothing
    Set db = Nothing
 
If Err.Number = 0 Then Exit Function
 
Error_Handler:
    MsgBox "MS Access has generated the following error" & vbCrLf & vbCrLf & "Error Number: " & _
    Err.Number & vbCrLf & "Error Source: findmaketbl" & vbCrLf & "Error Description: " & _
    Err.Description, vbCritical, "An Error has Occured!"
    Exit Function
End Function

'---------------------------------------------------------------------------------------
' Procedure : ValInTbl
' Author    : CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Verifies if a value is found in a table
' Copyright : The following may be altered and reused as you wish so long as the
'             copyright notice is left unchanged (including Author, Website and
'             Copyright).  It may not be sold/resold or reposted on other sites (links
'             back to this site are allowed).
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sTable    : Name of the table to search for the specified value
' sField    : Name of the field in the specified table to search for the specified value
' sValue    : Value to search for
'
' Usage:
'~~~~~~~
' ValInTbl("tbl_Units", "UnitNo", 54201)
' ValInTbl("tbl_Employees", "FirstName", "Daniel")
' ValInTbl("tbl_Followup", "AttendInitSession", True)
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2009-Mar-14             Initial Release
' 2         2010-Oct-13             Adjust the sSQL string based on the table field type
'---------------------------------------------------------------------------------------
Function ValInTbl(sTable As String, sField As String, sValue As String) As Boolean
On Error GoTo Error_Handler
    Dim db      As DAO.Database
    Dim rs      As DAO.Recordset
    Dim sSQL    As String
 
    Set db = CurrentDb()
    Select Case db.TableDefs(sTable).Fields(sField).Type
        Case dbByte, dbInteger, dbLong, dbSingle, dbDouble, dbBoolean
            sSQL = "SELECT [" & sField & "] FROM [" & sTable & "] WHERE [" & sField & "]=" & sValue
        Case dbText, dbMemo
            sSQL = "SELECT [" & sField & "] FROM [" & sTable & "] WHERE [" & sField & "]='" & sValue & "'"
        Case dbDate
            sSQL = "SELECT [" & sField & "] FROM [" & sTable & "] WHERE [" & sField & "]=#" & sValue & "#"
    End Select
    Set rs = db.OpenRecordset(sSQL, dbOpenSnapshot)
 
    If rs.RecordCount <> 0 Then
        ValInTbl = True
    Else
        ValInTbl = False
    End If
 
Error_Handler_Exit:
    On Error Resume Next
    rs.Close
    Set rs = Nothing
    Set db = Nothing
    Exit Function
 
Error_Handler:
    MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: ValInTbl" & vbCrLf & _
           "Error Description: " & Err.Description, _
           vbCritical, "An Error has Occured!"
    Resume Error_Handler_Exit
End Function

'---------------------------------------------------------------------------------------
' Procedure : WipeTables
' Author    : CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Empty all the tables in a db of all data (wipe the db clean (does not
'             include system tables)
' Copyright : The following code may be used as you please, but may not be resold, as
'             long as the header (Author, Website & Copyright) remains with the code.
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2008-Feb                Initial Release
'---------------------------------------------------------------------------------------
Function WipeTables() As String
On Error GoTo WipeTables_Error
    Dim db As DAO.Database
    Dim td As DAO.TableDefs
 
    Set db = CurrentDb()
    Set td = db.TableDefs
    DoCmd.SetWarnings False 'Turn off confirmation prompt to user
   
    For Each t In td    'loop through all the fields of the tables
        If Left(t.Name, 4) = "MSys" Or Left(t.Name, 1) = "~" Then GoTo Continue
        DoCmd.RunSQL ("DELETE [" & t.Name & "].* FROM [" & t.Name & "];")
Continue:
    Next
 
    DoCmd.SetWarnings True  'Turn back on confirmation prompt to user
    Set td = Nothing
    Set db = Nothing
    WipeTables = True
 
If Err.Number = 0 Then Exit Function
 
WipeTables_Error:
    MsgBox "MS Access has generated the following error" & vbCrLf & vbCrLf & "Error Number: " & _
    Err.Number & vbCrLf & "Error Source: WipeTables" & vbCrLf & _
    "Error Description: " & Err.Description, vbCritical, "An Error has Occured! "
    Exit Function
End Function

'---------------------------------------------------------------------------------------
' Procedure : WipeTable
' Author    : CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Empty all the data of the specified table
' Copyright : The following code may be used as you please, but may not be resold, as
'             long as the header (Author, Website & Copyright) remains with the code.
'
' Imput variables:
' ---------------
' strTblName: Name of the table to delete all the records in.
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2008-Feb                Initial Release
'---------------------------------------------------------------------------------------
Function WipeTable(strTblName As String) As String
On Error GoTo WipeTable_Error
 
    DoCmd.SetWarnings False 'Turn off confirmation prompt to user
   
    DoCmd.RunSQL ("DELETE [" & strTblName & "].* FROM [" & strTblName & "];")
 
    DoCmd.SetWarnings True  'Turn back on confirmation prompt to user

    WipeTable = True
 
If Err.Number = 0 Then Exit Function
 
WipeTable_Error:
    MsgBox "MS Access has generated the following error" & vbCrLf & vbCrLf & "Error Number: " & _
    Err.Number & vbCrLf & "Error Source: WipeTable" & vbCrLf & _
    "Error Description: " & Err.Description, vbCritical, "An Error has Occured! "
    Exit Function
End Function

'---------------------------------------------------------------------------------------
' Procedure : listTables
' Author    : CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Return a listing of all the tables in the database
' Copyright : The following code may be used as you please, but may not be resold, as
'             long as the header (Author, Website & Copyright) remains with the code.
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' bShowSys - True/False whether or not to include system tables in the list
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2008-June-01            Initial Release
'---------------------------------------------------------------------------------------
Function listTables(bShowSys As Boolean) As String
On Error GoTo listTables_Error
    Dim db As DAO.Database
    Dim td As DAO.TableDefs
 
    Set db = CurrentDb()
    Set td = db.TableDefs
    For Each t In td    'loop through all the fields of the tables
        If Left(t.Name, 4) = "MSys" And bShowSys = False Then GoTo Continue
        Debug.Print t.Name
        'CurrentDb().OpenRecordset ("DELETE * FROM " & t.Name)
Continue:
    Next
 
    Set td = Nothing
    Set db = Nothing
If Err.Number = 0 Then Exit Function
 
listTables_Error:
    MsgBox "MS Access has generated the following error" & vbCrLf & vbCrLf & "Error Number: " & _
    Err.Number & vbCrLf & "Error Source: listTable" & vbCrLf & _
    "Error Description: " & Err.Description, vbCritical, "An Error has Occured!"
    Exit Function
End Function