Instance of Acces remains open.

[paxman]

Hi

Using office 2003.

I am automating Access from Outlook to send emails and update access tables when the email is sent.

I have a problem that an instance of Access remains open if i run the code in outlook to update the Access tables. I have narrowed it down by checking task manager and can confirm that at any point up until the following code runs Access behaves itself and closes.

As soon as the code is run it stays around afterwards.

If the code as is can not be tweaked perhaps there is another way to do it that might work better using ADO?

The following is the current code.

Sub updateAccess(lngFileID As Long, lngContactID As Long)
Dim strCriteria As String
Dim strSQL As String
Dim lngEmployeeId As Long
'Dim lngContactID As Long
Dim EnquiryID As Integer
Dim strFileName As String
Dim strDocType As String
Dim lngIDCheck As Long
Dim varCheck As Variant
Dim blnQuoted As Boolean
 
    Dim dao As dao.DBEngine
    Dim wks As Workspace
    Dim dbs As Database
    Dim rst As Recordset
    Dim strAccessDir As String
    Dim StrDBName As String
    Dim objAccess As New Access.Application
 
 If lngContactID = 0 Or IsNull(lngContactID) Then 'do not update td_docsent if no contact is available.
Exit Sub
End If
 
 
    StrDBName = "\\dauntless\dbase\dbase.mdb"
 
     DBEngine.SystemDB = "\\Dauntless\Southall\DATABASE\*****.mda"
    'Set up reference to Access database.
    Set dao = CreateObject("DAO.DBEngine.36")
 
    Set wks = DBEngine.CreateWorkspace("WordLogin", "word", "word", dbUseJet)
 
    Set dbs = wks.OpenDatabase(StrDBName)
    lngEmployeeId = MDBuser
     Set rst = dbs.OpenRecordset("Filelist", dbOpenDynaset)
        If rst.RecordCount = 0 Then GoTo cleanup ' if no record exists in table exit
 
 
   strCriteria = "bwk_Filelist =" & lngFileID 'There are some records so carry on to update them
 
    rst.FindFirst strCriteria
 
    If Not rst.NoMatch Then 'If there is an existing record copy it's id field
 
    lngFileID = rst.Fields("bwk_Filelist")
    strFileName = rst.Fields("Filename")
    EnquiryID = rst.Fields("bwk_Enquiry")
'GoTo Jump
    Set rst = dbs.OpenRecordset("td_DocSent", dbOpenDynaset)
        If rst.RecordCount = 0 Then GoTo cleanup ' if no record exists in td_DocSent then exit
 
    ' it is a new record add the details
 
    rst.AddNew
    rst!bwk_SentDate = Now()
    rst!bwk_Filelist = lngFileID
    rst!bwk_Contact = lngContactID
    rst!bwk_Employee = lngEmployeeId
    rst.Update
 
End If
 
If Left(strFileName, 1) = "Q" Then ' it's a quote so show it as quoted
       strSQL = "SELECT * FROM td_QuoteSituation WHERE bwk_Enquiry = " & EnquiryID
    Set rst = dbs.OpenRecordset(strSQL)
        strSQL = "UPDATE td_QuoteSituation SET td_QuoteSituation!ft_QtEmailed = Now() " & _
        "WHERE (td_QuoteSituation!bwk_Enquiry) = " & EnquiryID
        dbs.Execute strSQL, dbFailOnError
        strSQL = "UPDATE td_QuoteSituation SET td_QuoteSituation!ft_QtComplete = Now() " & _
        "WHERE (td_QuoteSituation!bwk_Enquiry) = " & EnquiryID
        dbs.Execute strSQL, dbFailOnError
        strSQL = "SELECT * FROM td_Enquiry WHERE bwk_Enquiry = " & EnquiryID
        Set rst = dbs.OpenRecordset(strSQL)
        'blnQuoted = DLookup("Quoted", "td_Enquiry", "bwk_Enquiry = " & EnquiryID) '"bwk_Filelist = " & lngFileId)
        If rst.Fields("quoted") = 0 Then
           If MsgBox("Show this enquiry as Quoted?", vbYesNo, "Set as Quoted on Enquiry") = vbYes Then ''****************
         strSQL = "UPDATE td_Enquiry SET td_Enquiry!Quoted = true " & _
         "WHERE (td_Enquiry!bwk_Enquiry) = " & EnquiryID
         dbs.Execute strSQL, dbFailOnError
         End If
     End If
 End If
 
cleanup:
    rst.Close
     Set rst = Nothing
        dbs.Close
        Set dbs = Nothing
        wks.Close
        Set wks = Nothing
        Set objAccess = Nothing
        objAccess.quit
        Set dbs = Nothing
        Set dao = Nothing
End Sub
 

[twinnyfo]

Have you stepped through the cleanup to see if the code is actually executing every time? It appears that you are telling everything to close, but apparently it is not.

Perhaps adding

objAccess.Close

may help???

[paxman]

Tried that but it errored out as already has objAccess.quit earlier. Moved objAccess.quit to the end and it made no difference. Also realised i do not need to use objAccess as i assume the line Set dao = CreateObject("DAO.DBEngine.36") creates the link. (This code has been through many changes and iterations so bits get left behind).

However Access still remains in the background and yes it does step through all the code including closing all objects etc.

Anyone else any ideas?

Neil

[twinnyfo]

Neil,

Try adding code simlar to this:

    Dim appAccess As Object
    Dim dbAccess
    Set appAccess = CreateObject("Access.Application")
    dbAccess = appAccess.OpenCurrentDatabase("DBPath\DBName.accdb", True)
    appAccess.Visible = True
 

Because the variables appAccess and dbAccess are diminesioned within the scope of the sub, as soon as the sub closes, the db closes also. You might be able to do what you need to do using this method.

Hope this hepps!

[Rabbit]

You said that you have objAccess.quit earlier in your code, but I don't see it anywhere in your code.

[paxman]

Hi

Not sure how to use this exactly.

I still need to create a workspace to allow a log on to the back end database because of security. So what part would i be able to replace with this code?

I could try myself but probably will get tied up in knots :)

Neil

[paxman]

Sorry for some reason that line either did not copy or i somehow deleted it!

Neil

[paxman]

I seem to remember if you use appAccess.Visible = True it tries to open another instance of access which is in fact already running in my case.

[paxman]

I tried using the appAccess.Visible = true and the program seemed to freeze. Eventually found it had opened another instance of Access and a dialogue box was waiting for me to log in. So that would not solve the problem really.

Does anyone else have an insight?

thanks

neil

[Rabbit]

It's hard to say if you're missing a line of code. Please post your code with the missing line added back in.

[paxman]

Hi all

Here is the current code which works but leaves an instance of Access still open.

I did notice that there are more if than end if statements which i thought was not possible but it compiles and runs.
If i try adding an end if it says it has no if statement associated?
Could this be the problem somehow?

Sub updateAccess(lngFileID As Long, lngContactID As Long)
Dim strCriteria As String
Dim strSQL As String
Dim lngEmployeeId As Long
'Dim lngContactID As Long
Dim EnquiryID As Integer
Dim strFileName As String
Dim strDocType As String
Dim lngIDCheck As Long
Dim varCheck As Variant
Dim blnQuoted As Boolean
 
    Dim dao As dao.DBEngine
    Dim wks As Workspace
    Dim dbs As Database
    Dim rst As Recordset
    Dim strAccessDir As String
    Dim StrDBName As String
    Dim objAccess As New Access.Application
    '===================
        'Dim appAccess As Object
        'Dim dbAccess
        'Set appAccess = CreateObject("Access.Application")
        'dbAccess = appAccess.OpenCurrentDatabase("DBPath\DBName.accdb", True)
        'appAccess.Visible = True
    '=====================
 
If lngContactID = 0 Or IsNull(lngContactID) Then 'do not update td_docsent if no contact is available.
Exit Sub
End If
 
    'Set up ref to Access Backend database
    Set objAccess = CreateObject("Access.Application")
    StrDBName = "\\dauntless\dbase\dbase.mdb"
    'Debug.Print "DBName: " & StrDBName
    'Get security details from mda file
     DBEngine.SystemDB = "\\Dauntless\Southall\DATABASE\*****.mda"
    'Set up workspace and login to to Access backend
    Set dao = CreateObject("DAO.DBEngine.36")
    Set wks = DBEngine.CreateWorkspace("WordLogin", "word", "word", dbUseJet)
    Set dbs = wks.OpenDatabase(StrDBName)
 
    lngEmployeeId = MDBuser 'get user id
 
    Set rst = dbs.OpenRecordset("Filelist", dbOpenDynaset)
If rst.RecordCount = 0 Then GoTo cleanup ' if no record exists in table exit
        strCriteria = "bwk_Filelist =" & lngFileID 'There are some records so carry on to update them
        rst.FindFirst strCriteria
    If Not rst.NoMatch Then 'If there is an existing record copy it's id field etc.
 
    lngFileID = rst.Fields("bwk_Filelist")
    strFileName = rst.Fields("Filename")
    EnquiryID = rst.Fields("bwk_Enquiry")
    Set rst = dbs.OpenRecordset("td_DocSent", dbOpenDynaset)
        If rst.RecordCount = 0 Then GoTo cleanup ' if no record exists in td_DocSent then exit
    'it is a new record add the details
 
    rst.AddNew
    rst!bwk_SentDate = Now()
    rst!bwk_Filelist = lngFileID
    rst!bwk_Contact = lngContactID
    rst!bwk_Employee = lngEmployeeId
    rst.Update
 
    End If
 
    If Left(strFileName, 1) = "Q" Then ' it's a quote so show it as quoted
        strSQL = "SELECT * FROM td_QuoteSituation WHERE bwk_Enquiry = " & EnquiryID
        Set rst = dbs.OpenRecordset(strSQL)
        strSQL = "UPDATE td_QuoteSituation SET td_QuoteSituation!ft_QtEmailed = Now() " & _
        "WHERE (td_QuoteSituation!bwk_Enquiry) = " & EnquiryID
        dbs.Execute strSQL, dbFailOnError
        strSQL = "UPDATE td_QuoteSituation SET td_QuoteSituation!ft_QtComplete = Now() " & _
        "WHERE (td_QuoteSituation!bwk_Enquiry) = " & EnquiryID
        dbs.Execute strSQL, dbFailOnError
        strSQL = "SELECT * FROM td_Enquiry WHERE bwk_Enquiry = " & EnquiryID
        Set rst = dbs.OpenRecordset(strSQL)
        If rst.Fields("quoted") = 0 Then
           If MsgBox("Show this enquiry as Quoted?", vbYesNo, "Set as Quoted on Enquiry") = vbYes Then ''****************
         strSQL = "UPDATE td_Enquiry SET td_Enquiry!Quoted = true " & _
         "WHERE (td_Enquiry!bwk_Enquiry) = " & EnquiryID
         dbs.Execute strSQL, dbFailOnError
           End If
         End If
 
 End If
 
cleanup:
    rst.Close
     Set rst = Nothing
        dbs.Close
        Set dbs = Nothing
        wks.Close
        Set wks = Nothing
        objAccess.Quit
        Set dao = Nothing
End Sub
 

[paxman]

Hi

Just realised the lines with an if statement that are actioned on one line do not need an end if. So it probably is nothing to do with the problem in hand.

Neil

[Rabbit]

Set a breakpoint on the objAccess.Quit line and make sure it runs.

[NeoPa]

If you use CreateObject() instead of GetObject() then a new instance will always be created (except for applications like Outlook where it's limited to a single running instance).

Some issues to be aware of :

1. If an application doesn't have its .Visible property set to True then it's hard to know it's there until you look in Task Manager or something complains.
2. Any variables in your code still in scope and pointing to your application instance will keep it alive and open (regardless of visibility). The reverse is also true in as much as when none refer to it, and it has no documents open, then it will close automatically.
3. Some help can be found at Application Automation.

[strive4peace]

I suggest you add an error handler ...

at the top of your code, put this statement:

   On Error GoTo Proc_Err

and just above End Sub:

   Exit Sub
 
Proc_Err:
   MsgBox Err.Description, , _
        "ERROR " & Err.Number _
        & "   updateAccess"
 
   Resume cleanup
   Resume
 End Sub

Error Handling
www.AccessMVP.com/strive4peace/Code.htm

[strive4peace]

also, just after cleanup:, I suggest adding:

on error resume next

before releasing

[strive4peace]

you should CLOSE each rst before reusing the rst variable ...

[paxman]

Thanks for the reponses.

The objAccess.quit runs.

I will try all the code edits suggested and see what happens.

One thing to note is that Access is open all the time when we use our system so it is always visible. When i close it and it remains in the task manager is the only time i can see it has not closed properly. So as soon as i have automated via Outlook it works and then fails at the next automation action performed.

NeoPa are you suggesting that using GetObject() will help my situation? I will give it a try anyway and see.

Thanks all.

Neil

[paxman]

Hi guys

I FINALLY got this to work!!!!!!!!

A couple of changes.

Using GetObject() did not work initially as it tried to open another instance of Access.......but then i changed the reference to the Access front end and it ran and then Access closed. Did not take long to figure out i needed to remove the objAccess.quit and nothing stays behind in memory.

You would not believe i have spent a few hours each month for several months trying to figure this one out.

Thanks for all your help.

As it was GetObject() that did it i am awarding the best answer to NeoPa but thanks to all for trying to help me out. Much appreciated.

Regards

Neil

[twinnyfo]

So glad that you finally found a solution. This thread also puts some more tools in my kit for the future, if I need to perform such actions. Thanks NeoPa and others!

[NeoPa]

It's actually a good idea to Quit() the application before allowing the variables to go out of scope. It may be technically unnecessary but I always advise to code in such a way as to make the object of the code as clear as possible.

@Twinny.
Application Automation can be real fun. Have a play and discover lots you can do with it.