Test for Existing Table

R

RNUSZ@OKDPS

I have a need to test if a table exists in a current database system. Is
there a sample of what I would have to code in VB via a function in a form to
determine if table named CaseNames exists in table named Legal_FR.mdb. The
form would be the current active form and is part of Legal_FR.mdb. I need to
test if table exists, then, if it exists, I need to determine if records are
in table. If records exist, delete all records in table, continue processing
adding new records. If table doesn't exist, create table, add new records...
etc.

Any suggestions in VB code......

Thanks in advance
 
J

Jeff Conrad

in message:
I have a need to test if a table exists in a current database system. Is
there a sample of what I would have to code in VB via a function in a form to
determine if table named CaseNames exists in table named Legal_FR.mdb. The
form would be the current active form and is part of Legal_FR.mdb. I need to
test if table exists, then, if it exists, I need to determine if records are
in table. If records exist, delete all records in table, continue processing
adding new records. If table doesn't exist, create table, add new records...
etc.

Any suggestions in VB code......

Yes, using VBA. You posted this into the macro group. I would NOT
use a macro for this.

Will this code I whipped up for you work?

1. You will need to set a refernece to the DAO object library and of
course adjust to your needs.
2. Copy ALL of this code into a new standard module. Compile the
code, save and close the module with a name of basCaseNames.
3. Then test.

'************Code Start*****************
Public Sub CaseNamesCode()
On Error GoTo ErrorPoint

' Code by Jeff Conrad - Access Junkie
' © 2005 Conrad Systems Development
' Code for Robert Nusz - May 20th, 2005
' You are free to use in any applications provide
' of course that you admit you are an Access Junkie

Dim dbs As DAO.Database
Dim strSQL As String

Set dbs = CurrentDb

If funcTableExists("CaseNames") = True Then
' Table Exists in the database so don't create it
If DCount("*", "CaseNames") > 0 Then
' CaseNames table has records so delete them
strSQL = "DELETE * FROM CaseNames"
CurrentDb.Execute strSQL, dbFailOnError

' Now add whatever records we need to CaseNames
Call FillCaseNames
Else
' CaseNames table has no records
' You could actually not even have this extra
' step since deleting records where there are
' none will not cause a problem using above
' delete code.

' Now add whatever records we need to CaseNames
Call FillCaseNames
End If
Else
' Create a table called CaseNames with appropriate fields
If funcCreateTable = True Then
' Table successfully created

' Refresh the Database Window
RefreshDatabaseWindow

' Now add whatever records we need to CaseNames
Call FillCaseNames
Else
' Table was not created for some reason
' Inform the user and exit the procedure
MsgBox "This procedure could not complete." _
& vbNewLine & "Please call tech support immediately." _
, vbExclamation, "Procedure Error"
End If
End If

ExitPoint:
' Cleanup code
On Error Resume Next
dbs.Close
Set dbs = Nothing
Exit Sub

ErrorPoint:
Select Case Err.Number
Case 2501
' Action cancelled so just ignore
Case Else
' Unexpected Error
MsgBox "The following error has occurred:" _
& vbNewLine & "Error Number: " & Err.Number _
& vbNewLine & "Error Description: " & Err.Description _
, vbExclamation, "Unexpected Error"
End Select
Resume ExitPoint

End Sub

Public Function funcTableExists(strTable As String) As Boolean
On Error GoTo ErrorPoint

' This function will check to see if a table exists
' within the current database
' Similar to IsLoaded function it will return True or False

Dim db As DAO.Database
Dim doc As DAO.Document

Set db = CurrentDb()

With db.Containers!Tables
For Each doc In .Documents
If doc.Name = strTable Then
funcTableExists = True
Exit For
End If
Next doc
End With

ExitPoint:
' Cleanup code
On Error Resume Next
db.Close
Set db = Nothing
Exit Function

ErrorPoint:
' Unexpected Error
MsgBox "The following error has occurred:" _
& vbNewLine & "Error Number: " & Err.Number _
& vbNewLine & "Error Description: " & Err.Description _
, vbExclamation, "Unexpected Error"
Resume ExitPoint

End Function

Public Function funcCreateTable() As Boolean
On Error GoTo ErrorPoint

' This is where you put code to create the table
' If an error occurs we report back that the
' procedure failed

' If everything is good, the function returns true
' If an error occurs it will return False
funcCreateTable = True

ExitPoint:
' Cleanup code
On Error Resume Next
Exit Function

ErrorPoint:
Select Case Err.Number
Case 2603
' User lacks permission to create tables
MsgBox "You do not have sufficient permissions to " _
& "create the Case Names table in this database. " _
& vbNewLine & vbNewLine & "Please see the database " _
& "administrator to run this feature." _
, vbExclamation, "Unable To Create Table"
Case 2501
' Action cancelled so just ignore
Case Else
' Unexpected Error
MsgBox "The following error has occurred:" _
& vbNewLine & "Error Number: " & Err.Number _
& vbNewLine & "Error Description: " & Err.Description _
, vbExclamation, "Unexpected Error"
End Select
' Return False since we encounterd a problem
funcCreateTable = False
Resume ExitPoint

End Function

Public Sub FillCaseNames()
On Error GoTo ErrorPoint

' This is your code to fill the Case Names table

ExitPoint:
' Cleanup code
On Error Resume Next
Exit Sub

ErrorPoint:
Select Case Err.Number
Case 2501
' Action cancelled so just ignore
Case Else
' Unexpected Error
MsgBox "The following error has occurred:" _
& vbNewLine & "Error Number: " & Err.Number _
& vbNewLine & "Error Description: " & Err.Description _
, vbExclamation, "Unexpected Error"
End Select
Resume ExitPoint

End Sub
'************Code End*****************

Hope that helps,
 
R

RNUSZ@OKDPS

I'm having problems getting the code to work, will include a copy next
message..
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top