Link to home
Start Free TrialLog in
Avatar of Ralph Gould
Ralph GouldFlag for United States of America

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.
Avatar of Rey Obrero (Capricorn1)
Rey Obrero (Capricorn1)
Flag of United States of America image

test this, place the codes in a module in db1
Sub copyT()
'COPY TABLE from db3 to db2 codes executed at db1
    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.TransferDatabase acImport, "Microsoft Access", db3Path & "\db3.mdb", acTable, "Table1", "Table1"

    acc.CloseCurrentDatabase
    Set acc = Nothing

End Sub

Open in new window

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.
Avatar of Ralph Gould

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

Open in new window

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_Mphotos\RS Live Data.accdb"
    db2Path = "H:\CAC_Share\_CAC_RS_JG_Mphotos\20170111_CAC_Field_Surveyor_JobData_Template.accdb"
    Set acc = CreateObject("Access.Application")
   
    acc.OpenCurrentDatabase db2Path
    acc.DoCmd.DeleteObject acTable, "tblJobSpec"
    acc.DoCmd.TransferDatabase acImport, "Microsoft Access", db3Path, acTable, "tblJobSpec", "tblJobSpec"

    acc.CloseCurrentDatabase
    Set acc = Nothing
you did not include the error trapping routine.

copy the  whole codes and try again.
Rey
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
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_Mphotos\RS Live Data.accdb"
    db2Path = "H:\CAC_Share\_CAC_RS_JG_Mphotos\20170111_CAC_Field_Surveyor_JobData_Template.accdb"
    Set acc = CreateObject("Access.Application")
   
    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
<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
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
you can not delete a table if it is in use.

why do you need to replace the table?
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.
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.
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

Open in new window

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
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.
SOLUTION
Avatar of Rey Obrero (Capricorn1)
Rey Obrero (Capricorn1)
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
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
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.
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
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Folks; thanks for ur help
Thank You