troubleshooting Question

Run second object in vba

Avatar of PeterBaileyUk
PeterBaileyUk asked on
Microsoft Access
11 Comments3 Solutions426 ViewsLast Modified:
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

Bill Ross

Our community of experts have been thoroughly vetted for their expertise and industry experience.

Join our community to see this answer!
Unlock 3 Answers and 11 Comments.
Start Free Trial
Learn from the best

Network and collaborate with thousands of CTOs, CISOs, and IT Pros rooting for you and your success.

Andrew Hancock - VMware vExpert
See if this solution works for you by signing up for a 7 day free trial.
Unlock 3 Answers and 11 Comments.
Try for 7 days

”The time we save is the biggest benefit of E-E to our team. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange.

-Mike Kapnisakis, Warner Bros