Create a new module and paste this source code into it. Change the name of the module to basDatabase. If you have used some of our previous database issues you might already have a module called basDatabase so you can just add this source code to it. If you have any questions, email us at help@codeoftheweek.com
'----------------------------------------------------------------------
'
' Module Name: basDatabase
' Written By: C&D Programming Corp.
' Create Date: 9/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 CopyTableStructureToNewDB(sSourceDB As String, sDestDB 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
CopyTableStructureToNewDB = 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 & "] in '" _
& sDestDB & "' " & _
"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, "CopyTableStructureToNewDB", "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
CopyTableStructureToNewDB = True
Exit Function
Handler:
If bOpened Then
dbSource.Close
End If
Err.Raise Err.Number, "CopyTableStructureToNewDB", Err.Description
End Function