Source code for Issue Number 79

Copyright 1997-2000 by C&D Programming Corp. All Rights Reserved. Source code may not be reproduced except for use in a compiled executable. All rights reserved. If you would like to reprint any or all of this code please email us at info@codeoftheweek.com

Code of the Week Home


Source Code

Just create a new Module and then paste this source code into it. You should name the class basDatabase.

'----------------------------------------------------------------------
'
'   Module Name:    basDatabase
'   Written By:     C&D Programming Corp.
'   Create Date:    2/99
'   Copyright:      Copyright 1999 by C&D Programming Corp.  Source
'                   code may not be reproduced except for use in a
'                   compiled executable.  All rights reserved.  If
'                   you would like to reprint any or all of this
'                   code please email us at info@codeoftheweek.com
'----------------------------------------------------------------------
Option Explicit

Public Function CopyTableStructure(sSourceDB As String, sSourceTable As String, _
                                        sDestinationTable As String) As Boolean
    Dim dbSource As Database
    Dim dbDest As Database
    Dim tblSource As TableDef
    Dim tblDest As TableDef
    Dim bOpened As Boolean
    Dim fld As Field
    Dim idx As Index


    On Error GoTo Handler

    CopyTableStructure = False
    Set dbSource = DBEngine.OpenDatabase(sSourceDB, False)
    bOpened = True


    On Error Resume Next
    ' the WHERE clause is used to force no records to be returned.
    dbSource.Execute "SELECT [" & sSourceTable & "].* INTO [" & sDestinationTable & "] " & _
                "From [" & sSourceTable & "] WHERE (False=True)"
    If Err Then
        Dim lErr As Long
        Dim sErr As String
        lErr = Err.Number
        sErr = Err.Description
        On Error GoTo 0
        Err.Raise lErr, "CopyTableStructure", "An error occurred while trying to create the table structure from '[" & _
                        sSourceTable & "]'.  The error description is " & sErr
    End If
    On Error GoTo Handler

    dbSource.Close
    CopyTableStructure = True
    Exit Function

Handler:
    If bOpened Then
        dbSource.Close
    End If
    Err.Raise Err.Number, "CopyTableStructure", Err.Description
End Function