By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
459,253 Members | 1,693 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 459,253 IT Pros & Developers. It's quick & easy.

Instance of Acces remains open.

P: 11
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.
Expand|Select|Wrap|Line Numbers
  1. Sub updateAccess(lngFileID As Long, lngContactID As Long)
  2. Dim strCriteria As String
  3. Dim strSQL As String
  4. Dim lngEmployeeId As Long
  5. 'Dim lngContactID As Long
  6. Dim EnquiryID As Integer
  7. Dim strFileName As String
  8. Dim strDocType As String
  9. Dim lngIDCheck As Long
  10. Dim varCheck As Variant
  11. Dim blnQuoted As Boolean
  12.  
  13.     Dim dao As dao.DBEngine
  14.     Dim wks As Workspace
  15.     Dim dbs As Database
  16.     Dim rst As Recordset
  17.     Dim strAccessDir As String
  18.     Dim StrDBName As String
  19.     Dim objAccess As New Access.Application
  20.  
  21.  If lngContactID = 0 Or IsNull(lngContactID) Then 'do not update td_docsent if no contact is available.
  22. Exit Sub
  23. End If
  24.  
  25.  
  26.     StrDBName = "\\dauntless\dbase\dbase.mdb"
  27.  
  28.      DBEngine.SystemDB = "\\Dauntless\Southall\DATABASE\*****.mda"
  29.     'Set up reference to Access database.
  30.     Set dao = CreateObject("DAO.DBEngine.36")
  31.  
  32.     Set wks = DBEngine.CreateWorkspace("WordLogin", "word", "word", dbUseJet)
  33.  
  34.     Set dbs = wks.OpenDatabase(StrDBName)
  35.     lngEmployeeId = MDBuser
  36.      Set rst = dbs.OpenRecordset("Filelist", dbOpenDynaset)
  37.         If rst.RecordCount = 0 Then GoTo cleanup ' if no record exists in table exit
  38.  
  39.  
  40.    strCriteria = "bwk_Filelist =" & lngFileID 'There are some records so carry on to update them
  41.  
  42.     rst.FindFirst strCriteria
  43.  
  44.     If Not rst.NoMatch Then 'If there is an existing record copy it's id field
  45.  
  46.     lngFileID = rst.Fields("bwk_Filelist")
  47.     strFileName = rst.Fields("Filename")
  48.     EnquiryID = rst.Fields("bwk_Enquiry")
  49. 'GoTo Jump
  50.     Set rst = dbs.OpenRecordset("td_DocSent", dbOpenDynaset)
  51.         If rst.RecordCount = 0 Then GoTo cleanup ' if no record exists in td_DocSent then exit
  52.  
  53.     ' it is a new record add the details
  54.  
  55.     rst.AddNew
  56.     rst!bwk_SentDate = Now()
  57.     rst!bwk_Filelist = lngFileID
  58.     rst!bwk_Contact = lngContactID
  59.     rst!bwk_Employee = lngEmployeeId
  60.     rst.Update
  61.  
  62. End If
  63.  
  64. If Left(strFileName, 1) = "Q" Then ' it's a quote so show it as quoted
  65.        strSQL = "SELECT * FROM td_QuoteSituation WHERE bwk_Enquiry = " & EnquiryID
  66.     Set rst = dbs.OpenRecordset(strSQL)
  67.         strSQL = "UPDATE td_QuoteSituation SET td_QuoteSituation!ft_QtEmailed = Now() " & _
  68.         "WHERE (td_QuoteSituation!bwk_Enquiry) = " & EnquiryID
  69.         dbs.Execute strSQL, dbFailOnError
  70.         strSQL = "UPDATE td_QuoteSituation SET td_QuoteSituation!ft_QtComplete = Now() " & _
  71.         "WHERE (td_QuoteSituation!bwk_Enquiry) = " & EnquiryID
  72.         dbs.Execute strSQL, dbFailOnError
  73.         strSQL = "SELECT * FROM td_Enquiry WHERE bwk_Enquiry = " & EnquiryID
  74.         Set rst = dbs.OpenRecordset(strSQL)
  75.         'blnQuoted = DLookup("Quoted", "td_Enquiry", "bwk_Enquiry = " & EnquiryID) '"bwk_Filelist = " & lngFileId)
  76.         If rst.Fields("quoted") = 0 Then
  77.            If MsgBox("Show this enquiry as Quoted?", vbYesNo, "Set as Quoted on Enquiry") = vbYes Then ''****************
  78.          strSQL = "UPDATE td_Enquiry SET td_Enquiry!Quoted = true " & _
  79.          "WHERE (td_Enquiry!bwk_Enquiry) = " & EnquiryID
  80.          dbs.Execute strSQL, dbFailOnError
  81.          End If
  82.      End If
  83.  End If
  84.  
  85. cleanup:
  86.     rst.Close
  87.      Set rst = Nothing
  88.         dbs.Close
  89.         Set dbs = Nothing
  90.         wks.Close
  91.         Set wks = Nothing
  92.         Set objAccess = Nothing
  93.         objAccess.quit
  94.         Set dbs = Nothing
  95.         Set dao = Nothing
  96. End Sub
  97.  
Jun 17 '14 #1

✓ answered by 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.

Share this Question
Share on Google+
20 Replies


twinnyfo
Expert Mod 2.5K+
P: 3,482
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

Expand|Select|Wrap|Line Numbers
  1. objAccess.Close
may help???
Jun 17 '14 #2

P: 11
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
Jun 17 '14 #3

twinnyfo
Expert Mod 2.5K+
P: 3,482
Neil,

Try adding code simlar to this:

Expand|Select|Wrap|Line Numbers
  1.     Dim appAccess As Object
  2.     Dim dbAccess
  3.     Set appAccess = CreateObject("Access.Application")
  4.     dbAccess = appAccess.OpenCurrentDatabase("DBPath\DBName.accdb", True)
  5.     appAccess.Visible = True
  6.  
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!
Jun 17 '14 #4

Rabbit
Expert Mod 10K+
P: 12,430
You said that you have objAccess.quit earlier in your code, but I don't see it anywhere in your code.
Jun 17 '14 #5

P: 11
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
Jun 17 '14 #6

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

Neil
Jun 17 '14 #7

P: 11
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.
Jun 17 '14 #8

P: 11
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
Jun 20 '14 #9

Rabbit
Expert Mod 10K+
P: 12,430
It's hard to say if you're missing a line of code. Please post your code with the missing line added back in.
Jun 20 '14 #10

P: 11
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?

Expand|Select|Wrap|Line Numbers
  1. Sub updateAccess(lngFileID As Long, lngContactID As Long)
  2. Dim strCriteria As String
  3. Dim strSQL As String
  4. Dim lngEmployeeId As Long
  5. 'Dim lngContactID As Long
  6. Dim EnquiryID As Integer
  7. Dim strFileName As String
  8. Dim strDocType As String
  9. Dim lngIDCheck As Long
  10. Dim varCheck As Variant
  11. Dim blnQuoted As Boolean
  12.  
  13.     Dim dao As dao.DBEngine
  14.     Dim wks As Workspace
  15.     Dim dbs As Database
  16.     Dim rst As Recordset
  17.     Dim strAccessDir As String
  18.     Dim StrDBName As String
  19.     Dim objAccess As New Access.Application
  20.     '===================
  21.         'Dim appAccess As Object
  22.         'Dim dbAccess
  23.         'Set appAccess = CreateObject("Access.Application")
  24.         'dbAccess = appAccess.OpenCurrentDatabase("DBPath\DBName.accdb", True)
  25.         'appAccess.Visible = True
  26.     '=====================
  27.  
  28. If lngContactID = 0 Or IsNull(lngContactID) Then 'do not update td_docsent if no contact is available.
  29. Exit Sub
  30. End If
  31.  
  32.     'Set up ref to Access Backend database
  33.     Set objAccess = CreateObject("Access.Application")
  34.     StrDBName = "\\dauntless\dbase\dbase.mdb"
  35.     'Debug.Print "DBName: " & StrDBName
  36.     'Get security details from mda file
  37.      DBEngine.SystemDB = "\\Dauntless\Southall\DATABASE\*****.mda"
  38.     'Set up workspace and login to to Access backend
  39.     Set dao = CreateObject("DAO.DBEngine.36")
  40.     Set wks = DBEngine.CreateWorkspace("WordLogin", "word", "word", dbUseJet)
  41.     Set dbs = wks.OpenDatabase(StrDBName)
  42.  
  43.     lngEmployeeId = MDBuser 'get user id
  44.  
  45.     Set rst = dbs.OpenRecordset("Filelist", dbOpenDynaset)
  46. If rst.RecordCount = 0 Then GoTo cleanup ' if no record exists in table exit
  47.         strCriteria = "bwk_Filelist =" & lngFileID 'There are some records so carry on to update them
  48.         rst.FindFirst strCriteria
  49.     If Not rst.NoMatch Then 'If there is an existing record copy it's id field etc.
  50.  
  51.     lngFileID = rst.Fields("bwk_Filelist")
  52.     strFileName = rst.Fields("Filename")
  53.     EnquiryID = rst.Fields("bwk_Enquiry")
  54.     Set rst = dbs.OpenRecordset("td_DocSent", dbOpenDynaset)
  55.         If rst.RecordCount = 0 Then GoTo cleanup ' if no record exists in td_DocSent then exit
  56.     'it is a new record add the details
  57.  
  58.     rst.AddNew
  59.     rst!bwk_SentDate = Now()
  60.     rst!bwk_Filelist = lngFileID
  61.     rst!bwk_Contact = lngContactID
  62.     rst!bwk_Employee = lngEmployeeId
  63.     rst.Update
  64.  
  65.     End If
  66.  
  67.     If Left(strFileName, 1) = "Q" Then ' it's a quote so show it as quoted
  68.         strSQL = "SELECT * FROM td_QuoteSituation WHERE bwk_Enquiry = " & EnquiryID
  69.         Set rst = dbs.OpenRecordset(strSQL)
  70.         strSQL = "UPDATE td_QuoteSituation SET td_QuoteSituation!ft_QtEmailed = Now() " & _
  71.         "WHERE (td_QuoteSituation!bwk_Enquiry) = " & EnquiryID
  72.         dbs.Execute strSQL, dbFailOnError
  73.         strSQL = "UPDATE td_QuoteSituation SET td_QuoteSituation!ft_QtComplete = Now() " & _
  74.         "WHERE (td_QuoteSituation!bwk_Enquiry) = " & EnquiryID
  75.         dbs.Execute strSQL, dbFailOnError
  76.         strSQL = "SELECT * FROM td_Enquiry WHERE bwk_Enquiry = " & EnquiryID
  77.         Set rst = dbs.OpenRecordset(strSQL)
  78.         If rst.Fields("quoted") = 0 Then
  79.            If MsgBox("Show this enquiry as Quoted?", vbYesNo, "Set as Quoted on Enquiry") = vbYes Then ''****************
  80.          strSQL = "UPDATE td_Enquiry SET td_Enquiry!Quoted = true " & _
  81.          "WHERE (td_Enquiry!bwk_Enquiry) = " & EnquiryID
  82.          dbs.Execute strSQL, dbFailOnError
  83.            End If
  84.          End If
  85.  
  86.  End If
  87.  
  88. cleanup:
  89.     rst.Close
  90.      Set rst = Nothing
  91.         dbs.Close
  92.         Set dbs = Nothing
  93.         wks.Close
  94.         Set wks = Nothing
  95.         objAccess.Quit
  96.         Set dao = Nothing
  97. End Sub
  98.  
Jun 23 '14 #11

P: 11
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
Jun 23 '14 #12

Rabbit
Expert Mod 10K+
P: 12,430
Set a breakpoint on the objAccess.Quit line and make sure it runs.
Jun 23 '14 #13

NeoPa
Expert Mod 15k+
P: 31,768
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.
Jun 23 '14 #14

strive4peace
P: 36
I suggest you add an error handler ...

at the top of your code, put this statement:

Expand|Select|Wrap|Line Numbers
  1.    On Error GoTo Proc_Err
and just above End Sub:

Expand|Select|Wrap|Line Numbers
  1.    Exit Sub
  2.  
  3. Proc_Err:
  4.    MsgBox Err.Description, , _
  5.         "ERROR " & Err.Number _
  6.         & "   updateAccess"
  7.  
  8.    Resume cleanup
  9.    Resume
  10.  End Sub
Error Handling
www.AccessMVP.com/strive4peace/Code.htm
Jun 24 '14 #15

strive4peace
P: 36
also, just after cleanup:, I suggest adding:

Expand|Select|Wrap|Line Numbers
  1. on error resume next
before releasing
Jun 24 '14 #16

strive4peace
P: 36
you should CLOSE each rst before reusing the rst variable ...
Jun 24 '14 #17

P: 11
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
Jun 24 '14 #18

P: 11
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
Jun 24 '14 #19

twinnyfo
Expert Mod 2.5K+
P: 3,482
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!
Jun 24 '14 #20

NeoPa
Expert Mod 15k+
P: 31,768
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.
Jun 24 '14 #21

Post your reply

Sign in to post your reply or Sign up for a free account.