Ralph Gould
asked on
ms access 2010 vba, copy table from db1 to db2 from db3
this vba runs in the front-end of a split db. a linked table is used to collect data in a table in the Back-end. when completed I want to transfer/copy/replace a single record in a table in db2 with the same structure in db3 with the record in the BE, i.e. the unlinked table.
Link the table and then you can use an update query assuming you have a unique identifier to join on. You can actually specify a full path in a query to reference a table but I get the impression that this table name and database name might not always be static and so that will be just as much a problem as linking. The TransferDatabase method allows you to link as well as to import or export a table.
ASKER
Rey Thank you!
I didn't mention it before but I want to replace the table completely. Will this do that or will I get a copy?
PatHartman Thank You!
Linking is not an option in this case. What we are doing is creating a free-standing db for a field job and putting it in a dropbox
for our field person to use off-line
I didn't mention it before but I want to replace the table completely. Will this do that or will I get a copy?
PatHartman Thank You!
Linking is not an option in this case. What we are doing is creating a free-standing db for a field job and putting it in a dropbox
for our field person to use off-line
test this, this will delete the old table and replaced with the new one
Sub copyT()
'COPY TABLE from db3 to db2 codes executed at db1
On error goto Copy_Err
Dim acc As Object, db3Path as string, db2Path as string
db2Path="pathtodb2"
db3Path="pathtodb3"
Set acc = CreateObject("Access.Application")
acc.OpenCurrentDatabase db2Path & "\db2.mdb"
acc.DoCmd.DeleteObject acTable, "Table1"
acc.DoCmd.TransferDatabase acImport, "Microsoft Access", db3Path & "\db3.mdb", acTable, "Table1", "Table1"
acc.CloseCurrentDatabase
Set acc = Nothing
Copy_err:
If Err.Number = 7874 Then
Err.Clear
Resume Next
End If
End Sub
ASKER
Rey Thanks transferdb seems to work nicely. However. the delete does not. I get an additional copy of the table as ....1
Here's what I have:
'COPY TABLE from db3 to db2 codes executed at db1
Dim acc As Object, db3Path As String, db2Path As String
db3Path = "H:\CAC_Share\_CAC_RS_JG_M photos\RS Live Data.accdb"
db2Path = "H:\CAC_Share\_CAC_RS_JG_M photos\201 70111_CAC_ Field_Surv eyor_JobDa ta_Templat e.accdb"
Set acc = CreateObject("Access.Appli cation")
acc.OpenCurrentDatabase db2Path
acc.DoCmd.DeleteObject acTable, "tblJobSpec"
acc.DoCmd.TransferDatabase acImport, "Microsoft Access", db3Path, acTable, "tblJobSpec", "tblJobSpec"
acc.CloseCurrentDatabase
Set acc = Nothing
Here's what I have:
'COPY TABLE from db3 to db2 codes executed at db1
Dim acc As Object, db3Path As String, db2Path As String
db3Path = "H:\CAC_Share\_CAC_RS_JG_M
db2Path = "H:\CAC_Share\_CAC_RS_JG_M
Set acc = CreateObject("Access.Appli
acc.OpenCurrentDatabase db2Path
acc.DoCmd.DeleteObject acTable, "tblJobSpec"
acc.DoCmd.TransferDatabase
acc.CloseCurrentDatabase
Set acc = Nothing
you did not include the error trapping routine.
copy the whole codes and try again.
copy the whole codes and try again.
ASKER
Rey
oops, sorry, put it in but now get error 3211 vs 7874
oops, sorry, put it in but now get error 3211 vs 7874
that error 3211 means table is in use. you need to close it firsst
btw, before you run the codes to copy the table, make sure NOBODY is using the database. db2
ASKER
Rey; same 3211 error. it looks like the db is opened just before the deleteobject. Here's how it looks:
db.Close
Set db = Nothing
JobSpecFileName = DBFieldTemplatePath
DoCmd.SetWarnings False
'COPY TABLE from db3 to db2 codes executed at db1
On Error GoTo Copy_err
Dim acc As Object, db3Path As String, db2Path As String
db3Path = "H:\CAC_Share\_CAC_RS_JG_M photos\RS Live Data.accdb"
db2Path = "H:\CAC_Share\_CAC_RS_JG_M photos\201 70111_CAC_ Field_Surv eyor_JobDa ta_Templat e.accdb"
Set acc = CreateObject("Access.Appli cation")
acc.OpenCurrentDatabase db2Path
acc.DoCmd.DeleteObject acTable, "tblJobSpec"
acc.DoCmd.TransferDatabase acImport, "Microsoft Access", db3Path, acTable, "tblJobSpec", "tblJobSpec"
acc.CloseCurrentDatabase
Set acc = Nothing
Copy_err:
If Err.Number = 7874 Then
Debug.Print Err.Number
Err.Clear
Resume Next
End If
db.Close
Set db = Nothing
JobSpecFileName = DBFieldTemplatePath
DoCmd.SetWarnings False
'COPY TABLE from db3 to db2 codes executed at db1
On Error GoTo Copy_err
Dim acc As Object, db3Path As String, db2Path As String
db3Path = "H:\CAC_Share\_CAC_RS_JG_M
db2Path = "H:\CAC_Share\_CAC_RS_JG_M
Set acc = CreateObject("Access.Appli
acc.OpenCurrentDatabase db2Path
acc.DoCmd.DeleteObject acTable, "tblJobSpec"
acc.DoCmd.TransferDatabase
acc.CloseCurrentDatabase
Set acc = Nothing
Copy_err:
If Err.Number = 7874 Then
Debug.Print Err.Number
Err.Clear
Resume Next
End If
<it looks like the db is opened just before the deleteobject> that is correct, it is the table that should NOT be OPEN or in USE
ASKER
Rey:
The db I'm looking to delete the table from is an app used by our field technicians. So when it is opened, it opens with an autoexec and a main menu of app choices from the table I want to replace. what I need to do is delete/replace the table without opening the db. Maybe this is not possible
The db I'm looking to delete the table from is an app used by our field technicians. So when it is opened, it opens with an autoexec and a main menu of app choices from the table I want to replace. what I need to do is delete/replace the table without opening the db. Maybe this is not possible
you can not delete a table if it is in use.
why do you need to replace the table?
why do you need to replace the table?
ASKER
We use the one access app for all of our field techs. This table contains a single record that has all of the specs for the job this tech will do. So we update this record at central and want to replace the record with the new one. we then rename the template db to the tech and put it in his dropbox. He then has all the info necessary to perform the job wherever in the planet. I suppose we could just update the record, but there is an awful lot of fields. HTH
<I suppose we could just update the record, but there is an awful lot of fields.>
updating a single record will be quick even it has lots of fields.
updating a single record will be quick even it has lots of fields.
When I suggested linking to the BE, I didn't intend for the link to be permanent. Only for the controlling db to link to the target BE long enough to update the target data. The target DB never links back.
I do something similar but in my case, the app is creating an archive when an audit is complete but the technique might work for you.
It sounds like you need to create "working" databases with changing data that you want to send to technitions. My solution was to create a template database. It contained the necessary forms/reports, etc and empty tables. I compacted the template and saved it. Then when the user asked to archive an audit, I copied the template and renamed it to correspond to the audit that it would hold. The app then linked to the newly created audit db and ran append queries to copy the data from the main database into the archive. The last step was to delete the audit from the main database but I'm pretty sure you don't want to do that. If this would solve your problem, let me know and I'll dig out the code for you.
I do something similar but in my case, the app is creating an archive when an audit is complete but the technique might work for you.
It sounds like you need to create "working" databases with changing data that you want to send to technitions. My solution was to create a template database. It contained the necessary forms/reports, etc and empty tables. I compacted the template and saved it. Then when the user asked to archive an audit, I copied the template and renamed it to correspond to the audit that it would hold. The app then linked to the newly created audit db and ran append queries to copy the data from the main database into the archive. The last step was to delete the audit from the main database but I'm pretty sure you don't want to do that. If this would solve your problem, let me know and I'll dig out the code for you.
ASKER
PatHartman pretty close. I update the template with the job specs and put in techs dropbox. All I need to do is update the template table with the data from an identical local table. The table contains a single record with all the job specs fields. I would love to see ur code. tks
I think I got it all. Let me know if I missed a procedures.
Private Sub cmdSpecialArchive_Click()
Dim strMsg As String
On Error GoTo Proc_Err
If Me.Dirty Then
DoCmd.RunCommand acCmdSaveRecord
End If
If DLookup("ItemName", "qGetAuditType", "AuditParmsID = " & Forms!frmLogin!cboAuditParmsID) = "New Hires" Then
MsgBox "New Hires must be archived individualy. Use the archive button on the subscriber form.", vbOKOnly
MsgBox "Archive is cancelled", vbOKOnly
Me.txtName.SetFocus
Me.cmdArchive.Enabled = False
Me.cmdSpecialArchive.Enabled = False
Exit Sub
End If
strMsg = "Are you certain that you want to archive this audit? "
strMsg = strMsg & "Archiving the audit will create a back up database with all the data "
strMsg = strMsg & "but will remove it PERMANENTLY from the active audit database."
strMsg = strMsg & vbCr & "You will need the help of Maggio Solutions to restore this data."
strMsg = strMsg & vbCr & "Make sure that you have created any necessary reports to save with the archive."
strMsg = strMsg & vbCr & vbCr & "Select Yes to archive or No to cancel."
If MsgBox(strMsg, vbYesNo + vbQuestion) = vbYes Then
If MsgBox("All data for the current audit will now be removed from the active database.", vbYesNo + vbQuestion) = vbYes Then
DoCmd.RunMacro ("mWarningsOff")
Call CreateExtendedArchive
Forms!frmLogin!cboAuditParmsID.Requery
Me.txtName.SetFocus
Me.cmdArchive.Enabled = False
Me.cmdSpecialArchive.Enabled = False
DoCmd.RunMacro ("mWarningsOn")
Else
MsgBox "The Archive request has been cancelled.", vbOKOnly + vbInformation
End If
Else
MsgBox "The Archive request has been cancelled.", vbOKOnly + vbInformation
End If
Proc_Exit:
Exit Sub
Proc_Err:
MsgBox Err.Number & "--" & Err.Description, vbCritical
Resume Proc_Exit
End Sub
Public Sub CreateExtendedArchive()
Dim ws As DAO.Workspace
Dim db As DAO.Database
Dim qd As DAO.QueryDef
Dim rs As DAO.Recordset
Dim FromFileName As String
Dim ToFileName As String
Dim bePath As String
' Dim strFileName As String
Dim strPath As String
Dim fs As Scripting.FileSystemObject
On Error GoTo Proc_Err
Set db = CurrentDb() ' delete links
db.TableDefs.Delete "TEMPtblReviewStatus"
db.TableDefs.Delete "TEMPtblStatus"
db.TableDefs.Delete "TEMPtblRoles"
db.TableDefs.Delete "TEMPtblListValues"
db.TableDefs.Delete "TEMPtblAuditParms"
db.TableDefs.Delete "TEMPtblDocuments"
db.TableDefs.Delete "TEMPtblMembers"
db.TableDefs.Delete "TEMPtblRefDocs"
db.TableDefs.Delete "TEMPtblDependents"
db.TableDefs.Delete "TEMPtblHelpComments"
db.TableDefs.Delete "TEMPtblLtrSent"
db.TableDefs.Delete "TEMPtblVerificationPhase"
db.TableDefs.Delete "TEMPtblTPA"
db.TableDefs.Delete "TEMPtblComments"
'Get default Workspace
Set ws = DBEngine.Workspaces(0)
Set fs = CreateObject("Scripting.FileSystemObject")
If Forms!frmTPAName!txtPathName & "" = "" Then
MsgBox "Please select destination folder for the archive database.", vbOKOnly + vbInformation
Forms!frmTPAName!txtPathName.SetFocus
Exit Sub
Else
strPath = Forms!frmTPAName!txtPathName
If Right(strPath, 1) = "\" Then
Else
strPath = strPath & "\"
End If
End If
If Forms!frmTPAName!txtDatabaseName & "" = "" Then
MsgBox "Please enter a name for the archive database.", vbOKOnly + vbInformation
Forms!frmTPAName!txtDatabaseName.SetFocus
Else
ToFileName = strPath & Forms!frmTPAName!txtDatabaseName
End If
'Make sure there isn't already a file with the name of the new database
If Dir(ToFileName) <> "" Then Kill ToFileName
'Create a new accdb file
bePath = DLookup("JetPath", "UsysConnectionString", "LinkedID = 1")
FromFileName = bePath & "AuditArchiveTemplateVer49.accdb"
fs.CopyFile FromFileName, ToFileName, True
Set db = ws.OpenDatabase(ToFileName)
'link tables from archive database
DoCmd.TransferDatabase acLink, "Microsoft Access", ToFileName, acTable, "tblReviewStatus", "TEMPtblReviewStatus"
DoCmd.TransferDatabase acLink, "Microsoft Access", ToFileName, acTable, "tblStatus", "TEMPtblStatus"
DoCmd.TransferDatabase acLink, "Microsoft Access", ToFileName, acTable, "tblRoles", "TEMPtblRoles"
DoCmd.TransferDatabase acLink, "Microsoft Access", ToFileName, acTable, "tblListValues", "TEMPtblListValues"
DoCmd.TransferDatabase acLink, "Microsoft Access", ToFileName, acTable, "tblAuditParms", "TEMPtblAuditParms"
DoCmd.TransferDatabase acLink, "Microsoft Access", ToFileName, acTable, "tblDocuments", "TEMPtblDocuments"
DoCmd.TransferDatabase acLink, "Microsoft Access", ToFileName, acTable, "tblMembers", "TEMPtblMembers"
DoCmd.TransferDatabase acLink, "Microsoft Access", ToFileName, acTable, "tblRefDocs", "TEMPtblRefDocs"
DoCmd.TransferDatabase acLink, "Microsoft Access", ToFileName, acTable, "tblDependents", "TEMPtblDependents"
DoCmd.TransferDatabase acLink, "Microsoft Access", ToFileName, acTable, "tblHelpComments", "TEMPtblHelpComments"
DoCmd.TransferDatabase acLink, "Microsoft Access", ToFileName, acTable, "tblLtrSent", "TEMPtblLtrSent"
DoCmd.TransferDatabase acLink, "Microsoft Access", ToFileName, acTable, "tblVerificationPhase", "TEMPtblVerificationPhase"
DoCmd.TransferDatabase acLink, "Microsoft Access", ToFileName, acTable, "tblTPA", "TEMPtblTPA"
DoCmd.TransferDatabase acLink, "Microsoft Access", ToFileName, acTable, "tblComments", "TEMPtblComments"
db.TableDefs.Refresh 'needed because Access doesn't always "see" the new table quickly
'Using embedded SQL because Access "breaks" queries by changing all solumn names to "ExprX" if the tables they link to do not exist
DoCmd.RunSQL ("Insert Into TEMPtblAuditParms Select * From tblAuditParms Where AuditparmsID = " & Forms!frmLogin!cboAuditParmsID)
DoCmd.RunSQL ("Insert Into TEMPtblReviewStatus Select * From tblReviewStatus")
DoCmd.RunSQL ("Insert Into TEMPtblStatus Select * From tblStatus")
DoCmd.RunSQL ("Insert Into TEMPtblRoles Select * From tblRoles")
DoCmd.RunSQL ("Insert Into TEMPtblListValues Select * From tblListValues Where AuditparmsID = " & Forms!frmLogin!cboAuditParmsID)
DoCmd.RunSQL ("Insert Into TEMPtblDocuments Select * From tblDocuments")
DoCmd.RunSQL ("Insert Into TEMPtblMembers Select * From tblMembers Where AuditparmsID = " & Forms!frmLogin!cboAuditParmsID)
DoCmd.RunSQL ("Insert Into TEMPtblRefDocs SELECT tblRefDocs.* FROM tblMembers INNER JOIN tblRefDocs ON tblMembers.EmpID = tblRefDocs.EmpID WHERE tblMembers.AuditParmsID = " & [Forms]![frmLogin]![cboAuditParmsID])
DoCmd.RunSQL ("Insert Into TEMPtblDependents SELECT tblDependents.* FROM tblMembers INNER JOIN tblDependents ON tblMembers.EmpID = tblDependents.EmpID WHERE tblMembers.AuditParmsID = " & [Forms]![frmLogin]![cboAuditParmsID])
DoCmd.RunSQL ("Insert Into TEMPtblHelpComments SELECT tblHelpComments.* FROM tblMembers INNER JOIN tblHelpComments ON tblMembers.EmpID = tblHelpComments.EmpID WHERE tblMembers.AuditParmsID = " & [Forms]![frmLogin]![cboAuditParmsID])
DoCmd.RunSQL ("Insert Into TEMPtblLtrSent SELECT tblLtrSent.* FROM tblMembers INNER JOIN tblLtrSent ON tblMembers.EmpID = tblLtrSent.EmpID WHERE tblMembers.AuditParmsID = " & [Forms]![frmLogin]![cboAuditParmsID])
DoCmd.RunSQL ("Insert Into TEMPtblVerificationPhase SELECT tblVerificationPhase.* FROM tblMembers INNER JOIN (tblDependents INNER JOIN tblVerificationPhase ON tblDependents.DepID = tblVerificationPhase.DepID) ON tblMembers.EmpID = tblDependents.EmpID WHERE tblMembers.AuditParmsID = " & [Forms]![frmLogin]![cboAuditParmsID])
DoCmd.RunSQL ("Insert Into TEMPtblTPA Select * From tblTPA")
DoCmd.RunSQL ("Insert Into TEMPtblComments Select tblComments.* FROM tblMembers INNER JOIN (tblDependents INNER JOIN tblComments ON tblDependents.DepID = tblComments.DepID) ON tblMembers.EmpID = tblDependents.EmpID WHERE tblMembers.AuditParmsID = " & [Forms]![frmLogin]![cboAuditParmsID])
If Environ("UserName") = "Pat" Then 'give me a chance to cancel delete so I can keep testing with the same data
If MsgBox("Do you want to finish the archive?", vbYesNo + vbQuestion) = vbNo Then
Exit Sub
End If
End If
'update audit archive date in audit log
Set db = CurrentDb()
Set qd = db.QueryDefs!qAuditLog
qd.Parameters![enterauditparmsid] = Forms!frmLogin!cboAuditParmsID
If Forms!frmLogin!cboAuditParmsID <> 1 Then 'don't update for training audit
Set rs = qd.OpenRecordset
rs.Edit
rs!AuditArchiveDate = Date
rs!AuditName = Forms!frmLogin!cboAuditParmsID.Column(2)
rs!CoName = Forms!frmLogin!cboAuditParmsID.Column(3)
rs!CoAbbr = Forms!frmLogin!cboAuditParmsID.Column(4)
rs!UpdatedBy = Forms!frmLogin!txtUserID
rs.Update
rs.Close
End If
'set properties of archive database to make seeing objects more difficult. No db is secure.
Call SetStartupProperties(ToFileName)
'rename new archive to .accdr
FromFileName = ToFileName
ToFileName = Left(ToFileName, Len(ToFileName) - 1) & "r"
'Make sure there isn't already a file with the name of the new database
If Dir(ToFileName) <> "" Then Kill ToFileName
Name FromFileName As ToFileName
If Forms!frmLogin!cboAuditParmsID = 1 Then
MsgBox "The archive was created but the data will not be deleted because it is needed for the correct operation of the DEA application.", vbOKOnly + vbInformation
Else
'Delete archived data from database
DoCmd.OpenQuery "qDeleteArchivedAudit"
End If
MsgBox "Export Complete." & vbCr & " Your Archive is: " & vbCr & vbCr & ToFileName, vbOKOnly + vbInformation
db.Close
Set db = Nothing
Proc_Exit:
Exit Sub
Proc_Err:
Select Case Err.Number
Case 53
MsgBox "DEA audit template database could not be found.", vbOKOnly + vbInformation
Case 3265
Resume Next
Case Else
MsgBox Err.Number & "--" & Err.Description, vbCritical
Resume Proc_Exit
End Select
End Sub
Public Function SetStartupProperties(strDB)
Dim dbs As DAO.Database
Dim prp As Object
Dim strTitle As String
Const PROPERTY_NOT_FOUND As Integer = 3270
Const TEXT_TYPE As Integer = 10 ' Equivalent to DAO dbText data type.
Const BOOL_TYPE As Integer = 1 ' Equivalent to DAO dbBoolean data type.
Const LONG_TYPE As Integer = 4 ' Equivalent to DAO dbLong data type.
On Error GoTo ErrorHandler
Set dbs = DBEngine.Workspaces(0).OpenDatabase(strDB)
strTitle = "Dependent Eligibility Auditor®TM Proprietary Information"
' Try to set the property. If it fails, the property does not exist.
On Error Resume Next
dbs.Properties("AppTitle") = strTitle
Select Case Err.Number
Case PROPERTY_NOT_FOUND
' Create the new property.
Set prp = dbs.CreateProperty("AppTitle", TEXT_TYPE, strTitle)
dbs.Properties.Append prp
Resume Next
Case 0
' Refresh the title bar to reflect the change.
Application.RefreshTitleBar
Case Else
MsgBox Err.Number & "--" & Err.Description, vbCritical, vbOKOnly + vbInformation
GoTo ExitLine
End Select
dbs.Properties("AllowFullMenus") = False
Select Case Err.Number
Case PROPERTY_NOT_FOUND
' Create the new property.
Set prp = dbs.CreateProperty("AllowFullMenus", BOOL_TYPE, False)
dbs.Properties.Append prp
Resume Next
Case 0
' Refresh the title bar to reflect the change.
' Application.RefreshTitleBar
Case Else
MsgBox Err.Number & "--" & Err.Description, vbCritical, vbOKOnly + vbInformation
GoTo ExitLine
End Select
dbs.Properties("AllowShortcutMenus") = True
Select Case Err.Number
Case PROPERTY_NOT_FOUND
' Create the new property.
Set prp = dbs.CreateProperty("AllowShortcutMenus", BOOL_TYPE, True)
dbs.Properties.Append prp
Resume Next
Case 0
' Refresh the title bar to reflect the change.
' Application.RefreshTitleBar
Case Else
MsgBox Err.Number & "--" & Err.Description, vbCritical, vbOKOnly + vbInformation
GoTo ExitLine
End Select
dbs.Properties("StartupShowDBWindow") = False
Select Case Err.Number
Case PROPERTY_NOT_FOUND
' Create the new property.
Set prp = dbs.CreateProperty("StartupShowDBWindow", BOOL_TYPE, False)
dbs.Properties.Append prp
Resume Next
Case 0
' Refresh the title bar to reflect the change.
' Application.RefreshTitleBar
Case Else
MsgBox Err.Number & "--" & Err.Description, vbCritical, vbOKOnly + vbInformation
GoTo ExitLine
End Select
dbs.Properties("AllowBuiltInToolbars") = False
Select Case Err.Number
Case PROPERTY_NOT_FOUND
' Create the new property.
Set prp = dbs.CreateProperty("AllowBuiltInToolbars", BOOL_TYPE, False)
dbs.Properties.Append prp
Resume Next
Case 0
' Refresh the title bar to reflect the change.
' Application.RefreshTitleBar
Case Else
MsgBox Err.Number & "--" & Err.Description, vbCritical, vbOKOnly + vbInformation
GoTo ExitLine
End Select
dbs.Properties("AllowToolbarChanges") = False
Select Case Err.Number
Case PROPERTY_NOT_FOUND
' Create the new property.
Set prp = dbs.CreateProperty("AllowToolbarChanges", BOOL_TYPE, False)
dbs.Properties.Append prp
Resume Next
Case 0
' Refresh the title bar to reflect the change.
' Application.RefreshTitleBar
Case Else
MsgBox Err.Number & "--" & Err.Description, vbCritical, vbOKOnly + vbInformation
GoTo ExitLine
End Select
dbs.Properties("AllowBypassKey") = False
Select Case Err.Number
Case PROPERTY_NOT_FOUND
' Create the new property.
Set prp = dbs.CreateProperty("AllowBypassKey", BOOL_TYPE, False)
dbs.Properties.Append prp
Resume Next
Case 0
' Refresh the title bar to reflect the change.
' Application.RefreshTitleBar
Case Else
MsgBox Err.Number & "--" & Err.Description, vbCritical, vbOKOnly + vbInformation
GoTo ExitLine
End Select
dbs.Properties("AllowBreakIntoCode") = False
Select Case Err.Number
Case PROPERTY_NOT_FOUND
' Create the new property.
Set prp = dbs.CreateProperty("AllowBreakIntoCode", BOOL_TYPE, False)
dbs.Properties.Append prp
Resume Next
Case 0
' Refresh the title bar to reflect the change.
' Application.RefreshTitleBar
Case Else
MsgBox Err.Number & "--" & Err.Description, vbCritical, vbOKOnly + vbInformation
GoTo ExitLine
End Select
'' dbs.Properties("AllowSpecialKeys") = False
'' Select Case Err.Number
'' Case PROPERTY_NOT_FOUND
'' ' Create the new property.
'' Set prp = dbs.CreateProperty("AllowSpecialKeys", BOOL_TYPE, False)
'' dbs.Properties.Append prp
'' Resume Next
'' Case 0
'' ' Refresh the title bar to reflect the change.
'' Application.RefreshTitleBar
'' Case Else
'' MsgBox Err.Number & "--" & Err.Description, vbCritical, vbOKOnly+vbInformation
'' GoTo ExitLine
'' End Select
Call SetMDBAppIcon
ExitLine:
dbs.Close
Set dbs = Nothing
Set prp = Nothing
Exit Function
ErrorHandler:
Select Case Err.Number
Case Else
MsgBox Err.Number & "--" & Err.Description, vbCritical, vbOKOnly + vbInformation
Resume ExitLine
End Select
End Function
ASKER
PatHartmann Tks, very generous of you.
I think I'm stuck. I need to replace the data but the template is all set up as an operational database. so when I open it, it opens with a main menu based on data in the file I want to replace. so I can't delete it because its open. right now I use an fso copyobject from my front end local table to the template and its ok. Don't like the idea of a table in the front end but this is one of those "don't spend too much time on this" projects
I think I'm stuck. I need to replace the data but the template is all set up as an operational database. so when I open it, it opens with a main menu based on data in the file I want to replace. so I can't delete it because its open. right now I use an fso copyobject from my front end local table to the template and its ok. Don't like the idea of a table in the front end but this is one of those "don't spend too much time on this" projects
Why is the database open if it is something you send to people to use off line? The database that the code I posted creates is also an operational database. It is just not open at the time that the data is being replaced.
My code copies an empty template and fills it with data. Nothing is deleted from the template. The deletes are deleting the links from the db that is running the code. So, the links pointed to the last template that was created and it would have had a different name than the one I am currently working on.
I'm leaving now. If you can try to give me a clearer understanding of what you are using the code for, I might be able to help.
My code copies an empty template and fills it with data. Nothing is deleted from the template. The deletes are deleting the links from the db that is running the code. So, the links pointed to the last template that was created and it would have had a different name than the one I am currently working on.
I'm leaving now. If you can try to give me a clearer understanding of what you are using the code for, I might be able to help.
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Pat & Rey I thank you for ur quick responses, I certainly appreciate it.
Rey: maybe I'm just dense.
In the code u gave me, when I do this
acc.OpenCurrentDatabase db2Path the database is opened in another window.
then when I do this
acc.DoCmd.DeleteObject acTable, "tblJobSpec"
i get the 3211 error that the table is open and therefore can't delete it.
everything else works fine except I get "tblJobSpec1" as an additional table.
What am I missing?
Pat I'll take another look at ur code in the am. tks
Rey: maybe I'm just dense.
In the code u gave me, when I do this
acc.OpenCurrentDatabase db2Path the database is opened in another window.
then when I do this
acc.DoCmd.DeleteObject acTable, "tblJobSpec"
i get the 3211 error that the table is open and therefore can't delete it.
everything else works fine except I get "tblJobSpec1" as an additional table.
What am I missing?
Pat I'll take another look at ur code in the am. tks
The code that I posted doesn't cause the application's startup code to run so you don't end up with bound forms locking tables. The code also isn't deleting the tables. It is running append queries to copy data from the "code" database (the database where the code is running) to the linked tables. The table links in the "code" database are deleted before being recreated but that affects the "code" database, NOT the template database.
ASKER
Pat: I have 1 record in 1 table in the template to replace/update from an identical table/record in my Backend. Thats it. Would u suggest delete/delete replace or update as an approach or something else. tks
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Folks; thanks for ur help
ASKER
Thank You
Open in new window