Having trouble with temp table

B

bpcdavidson

Hi all, I have the following code on the click event of a button
which, every time it reaches the line marked with a * throws up a Type
Mismatch error.

Private Sub Command9_Click()

On Error GoTo Err_Command9_Click

' 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.

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
Set dbsTemp = wrkDefault.CreateDatabase(strTempDatabase,
dbLangGeneral)

strTableName = "temp Import TNA Results"

'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
Set tdfNew = dbsTemp.CreateTableDef(strTableName)
With tdfNew
.Fields.Append .CreateField("NAME", dbText)
.Fields.Append .CreateField("USER ID:", dbText)
.Fields.Append .CreateField("JOB TITLE", dbText)
.Fields.Append .CreateField("BAC", dbText)
.Fields.Append .CreateField("BUSINESS", dbText)
.Fields.Append .CreateField("LOCATION", dbText)
.Fields.Append .CreateField("OTHER", dbText)
.Fields.Append .CreateField("WIN XP SKILLS", dbText)
.Fields.Append .CreateField("DESK/LAPTOP", dbText)
.Fields.Append .CreateField("SUPERUSER", dbBoolean)
.Fields.Append .CreateField("WORD", dbText)
.Fields.Append .CreateField("EXCEL", dbText)
.Fields.Append .CreateField("ACCESS", dbText)
.Fields.Append .CreateField("POWERPOINT", dbText)
.Fields.Append .CreateField("OUTLOOK", dbText)
.Fields.Append .CreateField("FRONTPAGE", dbText)
.Fields.Append .CreateField("VISIO", dbText)
.Fields.Append .CreateField("PROJECT", dbText)
.Fields.Append .CreateField("USE OF LAPTOP", dbText)
.Fields.Append .CreateField("SP REQ", dbMemo)
.Fields.Append .CreateField("LOGIN", dbText)
.Fields.Append .CreateField("IMPORT DATE", dbDate)
dbsTemp.TableDefs.Append tdfNew
End With


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)*

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

Exit_Command9_Click:
Exit Sub

Err_Command9_Click:
MsgBox Err.Description
Resume Exit_Command9_Click

End Sub
 
G

Guest

What references do you have set. From the looks of it, you need the
Microsoft DAO 3.6 Object Library and when you dimension your RS object, you
probably need to dimension it as a DAO recordset.

DIM RS as DAO.Recordset

HTH
Dale
--
Email address is not valid.
Please reply to newsgroup only.


Hi all, I have the following code on the click event of a button
which, every time it reaches the line marked with a * throws up a Type
Mismatch error.

Private Sub Command9_Click()

On Error GoTo Err_Command9_Click

' 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.

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
Set dbsTemp = wrkDefault.CreateDatabase(strTempDatabase,
dbLangGeneral)

strTableName = "temp Import TNA Results"

'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
Set tdfNew = dbsTemp.CreateTableDef(strTableName)
With tdfNew
.Fields.Append .CreateField("NAME", dbText)
.Fields.Append .CreateField("USER ID:", dbText)
.Fields.Append .CreateField("JOB TITLE", dbText)
.Fields.Append .CreateField("BAC", dbText)
.Fields.Append .CreateField("BUSINESS", dbText)
.Fields.Append .CreateField("LOCATION", dbText)
.Fields.Append .CreateField("OTHER", dbText)
.Fields.Append .CreateField("WIN XP SKILLS", dbText)
.Fields.Append .CreateField("DESK/LAPTOP", dbText)
.Fields.Append .CreateField("SUPERUSER", dbBoolean)
.Fields.Append .CreateField("WORD", dbText)
.Fields.Append .CreateField("EXCEL", dbText)
.Fields.Append .CreateField("ACCESS", dbText)
.Fields.Append .CreateField("POWERPOINT", dbText)
.Fields.Append .CreateField("OUTLOOK", dbText)
.Fields.Append .CreateField("FRONTPAGE", dbText)
.Fields.Append .CreateField("VISIO", dbText)
.Fields.Append .CreateField("PROJECT", dbText)
.Fields.Append .CreateField("USE OF LAPTOP", dbText)
.Fields.Append .CreateField("SP REQ", dbMemo)
.Fields.Append .CreateField("LOGIN", dbText)
.Fields.Append .CreateField("IMPORT DATE", dbDate)
dbsTemp.TableDefs.Append tdfNew
End With


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)*

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

Exit_Command9_Click:
Exit Sub

Err_Command9_Click:
MsgBox Err.Description
Resume Exit_Command9_Click

End Sub
 

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