We help IT Professionals succeed at work.
Get Started

Run second object in vba

Last Modified: 2013-11-28
Ok I have used the technique in the related question perfectly. I now need to run another db and merely changed the name of the object but it fails.

Ooops left caps on :(

not sure why.

it says error 7866 I dont have exclusive access

It could be becuase i am linked to a table in that external db, so if thats the case can I create the link in vba after the process has run?

Private Sub Form_Open(Cancel As Integer)
'setup vars for first frm
Dim objAccess As Object
Dim frm As Object
'setup vars for 2nd frm
Dim objAccessPMV As Object
Dim frmPMV As Object

Dim db As DAO.Database
Dim DateValue As Date

DAO.DBEngine.SetOption dbMaxLocksPerFile, 100000

DoCmd.SetWarnings False

    Dim mydb As Database
    Set mydb = CurrentDb
    Set fileDatesRs = mydb.OpenRecordset("fileDates", dbOpenDynaset)
    localDataFileDate1 = fileDatesRs.code44_mdb.Value
    localDataFileDate2 = fileDatesRs.Data_dictionary_mdb.Value

    networkDataFile1 = "N:\data\ABI\code44.mdb"
    networkDataFile2 = "N:\data\ABI\Data_dictionary.mdb"
    Set fs = CreateObject("Scripting.FileSystemObject")
    If fs.FileExists(networkDataFile1) Then networkDataFileDate1 = FileDateTime(networkDataFile1)
    If fs.FileExists(networkDataFile2) Then networkDataFileDate2 = FileDateTime(networkDataFile2)
    If networkDataFileDate1 > localDataFileDate1 Or networkDataFileDate2 > localDataFileDate2 Then
        x = MsgBox("Newer data file exists. Do you wish to update ABICodes? ", vbYesNo + vbExclamation, "Newer File Exists")
        If x = vbYes Then
        'create form object and remotely run the click event
        Set objAccess = CreateObject("Access.Application")
        objAccess.OpenCurrentDatabase "N:\data\abi\AbiComparitor.mdb"
        objAccess.DoCmd.OpenForm "FrmMenu"
        Set frm = objAccess.Forms("FrmMenu")

            DoCmd.SetWarnings False
            Call frm.BtnBackUpDifferenceTable_Click
            'Delete rows from existing prev table
            DoCmd.RunSQL "DELETE *" _
            & " FROM AbiCodesPrevious;"
            'Populate Prev table from current Table
            DoCmd.RunSQL "INSERT INTO AbiCodesPrevious" _
            & " SELECT AbiCurrentCodes.*" _
            & " FROM AbiCurrentCodes;"

            'Delete rows from existing current table
            DoCmd.RunSQL "DELETE *" _
            & " FROM AbiCurrentCodes;"
                DoCmd.RunSQL "DELETE [ABICodes].* FROM ABICodes;"

                fileDatesRs.code44_mdb.Value = networkDataFileDate1
                fileDatesRs.Data_dictionary_mdb.Value = networkDataFileDate2
            'Populate current table from local Table
            DoCmd.RunSQL "INSERT INTO AbiCurrentCodes" _
            & " SELECT Tclient.*" _
            & " FROM Tclient;"
            'calculate differences
            Call frm.BtnCalculateDifferencesandAppendToTables_Click
            DoCmd.SetWarnings True
    'populate PostMatchValidator tables
        'Delete from tClient_PMV
        DoCmd.RunSQL "DELETE *" _
        & " FROM tClient_PMV;"
        'Populate tClient_PMV from local Table
        DoCmd.RunSQL "INSERT INTO tClient_PMV" _
        & " SELECT Tclient.*" _
        & " FROM Tclient;"
        'Delete from AbiToMvris_PMV
        DoCmd.RunSQL "DELETE *" _
        & " FROM AbiToMvris_PMV;"
        'Populate AbiToMvris_PMV from local Table
        DoCmd.RunSQL "INSERT INTO AbiToMvris_PMV" _
        & " SELECT AbiToMvris.*" _
        & " FROM AbiToMvris;"
        'Delete from tClientAlias_PMV
        DoCmd.RunSQL "DELETE *" _
        & " FROM tClientAlias_PMV;"
        'Populate tClientAlias_PMV from local Table
        DoCmd.RunSQL "INSERT INTO tClientAlias_PMV" _
        & " SELECT tClientAlias.*" _
        & " FROM tClientAlias;"
        'Delete from tCWAlias_PMV
        DoCmd.RunSQL "DELETE *" _
        & " FROM tCWAlias_PMV;"
        'Populate tCWAlias_PMV from local Table
        DoCmd.RunSQL "INSERT INTO tCWAlias_PMV" _
        & " SELECT tCWAlias.*" _
        & " FROM tCWAlias;"
        'Delete from SMMT_PMV
        DoCmd.RunSQL "DELETE *" _
        & " FROM SMMT_PMV;"
        'Populate SMMT_PMV from local Table
        & " SELECT SMMT.*" _
        & " FROM SMMT;"
    'populate Comparitor tables
        'Delete from AbiToMvris_comparitor
        DoCmd.RunSQL "DELETE *" _
        & " FROM AbiToMvris_comparitor;"
        'Populate AbiToMvris_comparitor from local Table
        DoCmd.RunSQL "INSERT INTO AbiToMvris_comparitor" _
        & " SELECT AbiToMvris.*" _
        & " FROM AbiToMvris;"
        'Delete from SMMT_comparitor
        DoCmd.RunSQL "DELETE *" _
        & " FROM SMMT_comparitor;"
        'Populate SMMT_comparitor from local Table
        DoCmd.RunSQL "INSERT INTO SMMT_comparitor" _
        & " SELECT SMMT.*" _
        & " FROM SMMT;"
        'Delete from FileDates_comparitor
        DoCmd.RunSQL "DELETE *" _
        & " FROM FileDates_comparitor;"
        'Populate FileDates_comparitor from local Table
        DoCmd.RunSQL "INSERT INTO FileDates_comparitor" _
        & " SELECT FileDates.*" _
        & " FROM FileDates;"
        'close first db
'******************** HELP HERE **********************************

        'now set up 2nd db and run click event
        Set objAccessPMV = CreateObject("Access.Application")
        'objAccessPMV.OpenCurrentDatabase "d:\data\abi\AbiPostValidator.mdb"
        objAccessPMV.OpenCurrentDatabase "N:\data\abi\AbiPostValidator.mdb"
        objAccessPMV.DoCmd.OpenForm "FrmMenu"
        Set frmPMV = objAccessPMV.Forms("FrmMenu")
        Call frmPMV.BtnGetDerivedData_Click
        'close db
        'Set objAccess = Nothing
        'Set objAccessPMV = Nothing
        End If
    End If


Open in new window

Watch Question
This problem has been solved!
Unlock 3 Answers and 11 Comments.
See Answers
Why Experts Exchange?

Experts Exchange always has the answer, or at the least points me in the correct direction! It is like having another employee that is extremely experienced.

Jim Murphy
Programmer at Smart IT Solutions

When asked, what has been your best career decision?

Deciding to stick with EE.

Mohamed Asif
Technical Department Head

Being involved with EE helped me to grow personally and professionally.

Carl Webster
CTP, Sr Infrastructure Consultant
Ask ANY Question

Connect with Certified Experts to gain insight and support on specific technology challenges including:

  • Troubleshooting
  • Research
  • Professional Opinions
Did You Know?

We've partnered with two important charities to provide clean water and computer science education to those who need it most. READ MORE