INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Jobs

How To

Create temporary MDB for temporary tables by dhookom
Posted: 15 Jul 05

There are times when temporary tables are necessary for reporting or other purposes. For instance you might want to pull records from other ODBC data sources into Access tables for more efficient reporting.

Creating these in your front-end mdb can result in serious bloat. This solution creates a temporary mdb with tables, fields, and indexes. The tables from this temporary MDB are then linked into your current (front-end) mdb.

The data definition table (ztblTempStructure) is in my primary front-end so I can redefine the "temporary" tables at any time. My table structure is:

  ztblTempStructure
  ========================
  TableName  text
  FieldName  Text
  FieldType  Number (integer)
  FieldSize  Number (integer)
  Indexed    Yes/No
  PrimaryKey Yes/No

The code requires a reference to the MS DAO object library:

CODE

Function BldTempTables() As Boolean
  '============================================================
  '  Programmer: DHookom
  '  Revision #:
  ' Called From:
  '        Date: 7/5/01
  '  Parameters:
  '============================================================
    On Error GoTo BldTempTables_Err
    Dim strErrMsg As String 'For Error Handling

    'Dim the objects
    Dim dbThis As DAO.Database
    Dim dbTemp As DAO.Database
    Dim tdf As DAO.TableDef
    Dim fld As DAO.Field
    Dim ndx As DAO.Index
    Dim rsStruct As DAO.Recordset   'the struct table
    
    'Dim the variables
    Dim strFolder As String         'the folder this application is located in
    Dim strThisDBName As String     'the name of this MDB
    Dim strTempDBName As String     'The name of the temp mdb
    Dim strTableName As String      'the table name
    
    Set dbThis = CurrentDb
    strThisDBName = dbThis.Name
    strFolder = Left(strThisDBName, Len(strThisDBName) - _
                Len(Dir(strThisDBName)))
    strTempDBName = strFolder & "PrdRptTemp.MDB"
    On Error Resume Next
    Kill strTempDBName 'if the old one exists, delete it
    On Error GoTo BldTempTables_Err
    'Create the new empty database
    Set dbTemp = CreateDatabase(strTempDBName, dbLangGeneral)
    Set rsStruct = dbThis.OpenRecordset("Select TableName, FieldName, " & _
            "FieldType, FieldSize, Indexed " & _
            "FROM ztblTempStructure ORDER BY TableName")
    With rsStruct
        If Not .EOF Then
            .MoveFirst
            Do Until .EOF
                strTableName = !TableName
                Set tdf = dbTemp.CreateTableDef(strTableName)
                Do Until !TableName <> strTableName
                    Select Case !FieldType
                        Case dbText
                            Set fld = tdf.CreateField(!FieldName, _
                                     !FieldType, !FieldSize)
                            fld.AllowZeroLength = True
                        Case Else
                            Set fld = tdf.CreateField(!FieldName, !FieldType)
                    End Select
                    
                    tdf.Fields.Append fld
                    tdf.Fields.Refresh
                    .MoveNext
                    If .EOF Then
                        Exit Do
                    End If
                Loop
                dbTemp.TableDefs.Append tdf
                dbTemp.TableDefs.Refresh
    
            Loop
        End If
        .Close
    End With
    
    'Create the indexes
    Set rsStruct = dbThis.OpenRecordset("Select TableName, FieldName, " & _
            "FieldType, Indexed, PrimaryKey " & _
            "FROM ztblTempStructure " & _
            "WHERE Indexed = -1 OR PrimaryKey = -1 ORDER BY TableName")
    With rsStruct
        .MoveFirst
        If Not .EOF Then
            .MoveFirst
            Do Until .EOF
                Set tdf = dbTemp.TableDefs(!TableName)
                'Debug.Print tdf.Name
                strTableName = !TableName
                Do Until !TableName <> strTableName
                    'Debug.Print "-" & !FieldName
                    Set ndx = tdf.CreateIndex(!FieldName)
                    Set fld = ndx.CreateField(!FieldName, !FieldType)
                    ndx.Fields.Append fld
                    'set up the primary key Field.
                    If !PrimaryKey = True Then
                        ndx.Primary = True
                    End If
                    tdf.Indexes.Append ndx
                    tdf.Indexes.Refresh
                    .MoveNext
                    If .EOF Then
                        Exit Do
                    End If
                Loop
            Loop
        End If
        .Close
    End With
    Set rsStruct = dbThis.OpenRecordset("Select Distinct TableName " & _
                 "From ztblTempStructure")
    'relink the tables
    With rsStruct
        .MoveFirst
        Do Until .EOF
            DoCmd.DeleteObject acTable, !TableName
            DoCmd.TransferDatabase acLink, "Microsoft Access", _
                  strTempDBName, acTable, !TableName, !TableName
            dbThis.TableDefs.Refresh
            .MoveNext
        Loop
        .Close
    End With
    Set rsStruct = Nothing
    Set dbThis = Nothing
    Set dbTemp = Nothing
    BldTempTables = True

BldTempTables_Exit:
    Exit Function

BldTempTables_Err:
    Select Case Err
        Case Else
            strErrMsg = strErrMsg & "Error #: " & Format$(Err.Number) & vbCrLf
            strErrMsg = strErrMsg & "Error Description: " & Err.Description
            MsgBox strErrMsg, vbInformation, "BldTempTables"
            BldTempTables = False
            Resume BldTempTables_Exit
    End Select
End Function

Back to Microsoft: Access Tables and Relationships FAQ Index
Back to Microsoft: Access Tables and Relationships Forum

My Archive

Resources

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close