G
geebee
I have the following code. My goal is to create a temp db that holds the
tables used for updating records. But the code seems to not be doing
anything in terms of creating the database. I am getting the MsgBoxes, but
nothing else it seems. The purpose is to create a temp db for all the
updates, and have the real backend file be linked to the tables in the temp
file, so that the tables in the real backend file are not bloated so much.
Here is my code? Can I specify exactly where to create the temp mdb?
I am using a button in a form to invoke the code. The button's onclick is
set to TempTablesSample
Option Compare Database
Option Explicit
Public Sub TempTablesSample()
' This subroutine illustrates how to use a temporary MDB in your app.
' If the temporary MDB is present then delete it.
' The name of the temporary MDB created is the same as the current Front
End (FE) name with
' " temp" added to the end of the name.
' Create the temporary MDB.
' Create the temporary table(s) required in the temporary MDB.
' Link to those tables within your current FE
' Do whatever you want
' Unlink the tables'
' Delete the temporary MDB
' While this code is copyright 2000 by Tony Toews it's all code strung
together from the online help so do
' whatever you like with this. At your own risk.
MsgBox "its working"
Dim tdfNew As TableDef, RS As Recordset
Dim wrkDefault As Workspace
Dim dbsTemp As Database, strTempDatabase As String
Dim strTableName As String
' Get default Workspace.
Set wrkDefault = DBEngine.Workspaces(0)
strTempDatabase = Left$(CurrentDb.Name, Len(CurrentDb.Name) - 4) & "
temp.mdb"
' Make sure there isn't already a file with the name of
' the new database.
If Dir(strTempDatabase) <> "" Then Kill strTempDatabase
'Create a new temp database
MsgBox "creating new"
Set dbsTemp = wrkDefault.CreateDatabase(strTempDatabase, dbLangGeneral)
strTableName = "temp Import Materials"
'strBracketedTableName = "[" & strTableName & "]"
' Delete the link to the temp table if it exists
If TableExists(strTableName) Then
CurrentDb.TableDefs.Delete strTableName
End If
' Create the temp table
MsgBox "creating tables"
Set tdfNew = dbsTemp.CreateTableDef(strTableName)
With tdfNew
.Fields.Append .CreateField("Invoice", dbLong)
.Fields.Append .CreateField("InvoiceItemNumber", dbInteger)
.Fields.Append .CreateField("InvoiceMaterialCode", dbText)
.Fields.Append .CreateField("Line2", dbText)
.Fields.Append .CreateField("Line3", dbText)
.Fields.Append .CreateField("LengthOrQuantity", dbDouble)
dbsTemp.TableDefs.Append tdfNew
End With
MsgBox "tbls created"
dbsTemp.TableDefs.Refresh
Dim tdfLinked As TableDef
' Link to the Import tables in the temp MDB
Set tdfLinked = CurrentDb.CreateTableDef(strTableName)
tdfLinked.Connect = ";DATABASE=" & strTempDatabase
tdfLinked.SourceTableName = strTableName
CurrentDb.TableDefs.Append tdfLinked
CurrentDb.TableDefs.Refresh
RefreshDatabaseWindow
Set RS = CurrentDb.OpenRecordset(strTableName, dbOpenDynaset,
dbAppendOnly)
' Do your logic to the temp tables here.
RS.Close
dbsTemp.Close
CurrentDb.TableDefs.Refresh
Set RS = Nothing
Set dbsTemp = Nothing
' Unlink the tables
CurrentDb.TableDefs.Delete strTableName
' Delete the temp mdb
strTempDatabase = Left$(CurrentDb.Name, Len(CurrentDb.Name) - 4) & "
temp.mdb"
Kill (strTempDatabase)
tagExit:
Exit Sub
tagError:
DoCmd.Hourglass False
If Err.Number = 70 Then
MsgBox "Unable to delete temporary database as it is locked." &
vbCrLf & vbCrLf & _
"Import cancelled."
Else
MsgBox Err.Description, vbCritical
End If
End Sub
Function TableExists(strTableName As String) As Integer
' Checks for the existance of a specific table
'Added the tabledefs.refresh as tables just added in this session weren't
' being picked up.
Dim dbDatabase As Database, tdefTable As TableDef
On Error Resume Next
Set dbDatabase = DBEngine(0)(0)
dbDatabase.TableDefs.Refresh
Set tdefTable = dbDatabase(strTableName)
' If an error occurred the tabledef object could not be accessed and
' therefore doesn't exist. This could cause problems in a secured
environment
' though as access may be denied.
If Err = 0 Then
TableExists = True
Else
TableExists = False
End If
End Function
Thanks in advance,
geebee
tables used for updating records. But the code seems to not be doing
anything in terms of creating the database. I am getting the MsgBoxes, but
nothing else it seems. The purpose is to create a temp db for all the
updates, and have the real backend file be linked to the tables in the temp
file, so that the tables in the real backend file are not bloated so much.
Here is my code? Can I specify exactly where to create the temp mdb?
I am using a button in a form to invoke the code. The button's onclick is
set to TempTablesSample
Option Compare Database
Option Explicit
Public Sub TempTablesSample()
' This subroutine illustrates how to use a temporary MDB in your app.
' If the temporary MDB is present then delete it.
' The name of the temporary MDB created is the same as the current Front
End (FE) name with
' " temp" added to the end of the name.
' Create the temporary MDB.
' Create the temporary table(s) required in the temporary MDB.
' Link to those tables within your current FE
' Do whatever you want
' Unlink the tables'
' Delete the temporary MDB
' While this code is copyright 2000 by Tony Toews it's all code strung
together from the online help so do
' whatever you like with this. At your own risk.
MsgBox "its working"
Dim tdfNew As TableDef, RS As Recordset
Dim wrkDefault As Workspace
Dim dbsTemp As Database, strTempDatabase As String
Dim strTableName As String
' Get default Workspace.
Set wrkDefault = DBEngine.Workspaces(0)
strTempDatabase = Left$(CurrentDb.Name, Len(CurrentDb.Name) - 4) & "
temp.mdb"
' Make sure there isn't already a file with the name of
' the new database.
If Dir(strTempDatabase) <> "" Then Kill strTempDatabase
'Create a new temp database
MsgBox "creating new"
Set dbsTemp = wrkDefault.CreateDatabase(strTempDatabase, dbLangGeneral)
strTableName = "temp Import Materials"
'strBracketedTableName = "[" & strTableName & "]"
' Delete the link to the temp table if it exists
If TableExists(strTableName) Then
CurrentDb.TableDefs.Delete strTableName
End If
' Create the temp table
MsgBox "creating tables"
Set tdfNew = dbsTemp.CreateTableDef(strTableName)
With tdfNew
.Fields.Append .CreateField("Invoice", dbLong)
.Fields.Append .CreateField("InvoiceItemNumber", dbInteger)
.Fields.Append .CreateField("InvoiceMaterialCode", dbText)
.Fields.Append .CreateField("Line2", dbText)
.Fields.Append .CreateField("Line3", dbText)
.Fields.Append .CreateField("LengthOrQuantity", dbDouble)
dbsTemp.TableDefs.Append tdfNew
End With
MsgBox "tbls created"
dbsTemp.TableDefs.Refresh
Dim tdfLinked As TableDef
' Link to the Import tables in the temp MDB
Set tdfLinked = CurrentDb.CreateTableDef(strTableName)
tdfLinked.Connect = ";DATABASE=" & strTempDatabase
tdfLinked.SourceTableName = strTableName
CurrentDb.TableDefs.Append tdfLinked
CurrentDb.TableDefs.Refresh
RefreshDatabaseWindow
Set RS = CurrentDb.OpenRecordset(strTableName, dbOpenDynaset,
dbAppendOnly)
' Do your logic to the temp tables here.
RS.Close
dbsTemp.Close
CurrentDb.TableDefs.Refresh
Set RS = Nothing
Set dbsTemp = Nothing
' Unlink the tables
CurrentDb.TableDefs.Delete strTableName
' Delete the temp mdb
strTempDatabase = Left$(CurrentDb.Name, Len(CurrentDb.Name) - 4) & "
temp.mdb"
Kill (strTempDatabase)
tagExit:
Exit Sub
tagError:
DoCmd.Hourglass False
If Err.Number = 70 Then
MsgBox "Unable to delete temporary database as it is locked." &
vbCrLf & vbCrLf & _
"Import cancelled."
Else
MsgBox Err.Description, vbCritical
End If
End Sub
Function TableExists(strTableName As String) As Integer
' Checks for the existance of a specific table
'Added the tabledefs.refresh as tables just added in this session weren't
' being picked up.
Dim dbDatabase As Database, tdefTable As TableDef
On Error Resume Next
Set dbDatabase = DBEngine(0)(0)
dbDatabase.TableDefs.Refresh
Set tdefTable = dbDatabase(strTableName)
' If an error occurred the tabledef object could not be accessed and
' therefore doesn't exist. This could cause problems in a secured
environment
' though as access may be denied.
If Err = 0 Then
TableExists = True
Else
TableExists = False
End If
End Function
Thanks in advance,
geebee