PDA

View Full Version : Access stuck in memory after running code in Outlook



paxman
08-01-2013, 04:35 AM
Hi

Using office 2003.

I am automating Outlook through Access 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.

I can not see that i have not set any objects to nothing (even put them where i probably should not just to see).

It all works but Access hangs around. So can anyone tell me what i am doing wrong?

Had to remove backslashes to get it to post.

thanks

Neil
-------------------------
CODE
Private Sub updateAccess(lngFileId As Long, lngContactID As Long)
Dim db As dao.Database

Dim ws As Workspace
Dim rst As dao.Recordset
Dim dbEng As dao.DBEngine
Dim strCriteria As String
Dim StrDBName 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

If Nz(lngContactID) = 0 Then 'do not update td_docsent if no contact is available.
Exit Sub
End If
Set dbEng = Application.CreateObject("DAO.DBEngine.36")

DBEngine.SystemDB = "OurServer Southall DATABASE System1.mda"
Set ws = DBEngine.CreateWorkspace("tasakoWS", "word", "word", dbUseJet)

'strDBName = "C: DATABASE frontend.mdb
StrDBName = "OurServer Backend.mdb"
Set db = ws.OpenDatabase(StrDBName)

lngEmployeeId = CLng(Forms!frmUserLog!txtEmployeeID)

' Perhaps look up contactId to save in the td_docsent table

'If (Forms!frmUserLog!txtContactID) <> "" Then 'read contact id for later use
'lngContactID = CLng(Forms!frmUserLog!txtContactID)
'Else
'GoTo JumpOut
'End If

Set rst = db.OpenRecordset("filelist", dbOpenDynaset)
If rst.RecordCount = 0 Then ' if no record exists exit
rst.Close
Set rst = Nothing
Call ClearUserTempLog
db.Close
Set db = Nothing
ws.Close
Set ws = Nothing

Set dbEng = Nothing


Exit Sub ' exit if no records
End If
strCriteria = "bwk_Filelist =" & lngFileId

rst.FindFirst strCriteria

If Not rst.NoMatch Then 'If there is an existing record copy it's id field

lngFileId = rst.Fields("bwk_Filelist")
rst.Close
Set rst = db.OpenRecordset("td_DocSent", dbOpenDynaset)
If rst.RecordCount = 0 Then ' if no record exists in td_DocSent then exit
rst.Close
Set rst = Nothing
Call ClearUserTempLog
db.Close
Set db = Nothing
ws.Close
Set ws = Nothing
Set dbEng = Nothing

Exit Sub ' exit if no records
End If
'strCriteria = "bwk_Filelist =" & intFileId

' 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
strFileName = DLookup("Filename", "filelist", "bwk_Filelist = " & lngFileId)

If Left(strFileName, 1) = "Q" Then ' it's a quote so show it as quoted
EnquiryID = DLookup("bwk_Enquiry", "filelist", "bwk_Filelist = " & lngFileId)
strSQL = "SELECT * FROM td_QuoteSituation WHERE bwk_Enquiry = " & EnquiryID
Set rst = db.OpenRecordset(strSQL)

'strSQL = "UPDATE td_QuoteSituation SET td_QuoteSituation!ft_QtStarted = Now() " & _
"WHERE (td_QuoteSituation!bwk_Enquiry) = " & EnquiryID
strSQL = "UPDATE td_QuoteSituation SET td_QuoteSituation!ft_QtEmailed = Now() " & _
"WHERE (td_QuoteSituation!bwk_Enquiry) = " & EnquiryID
db.Execute strSQL, dbFailOnError
strSQL = "UPDATE td_QuoteSituation SET td_QuoteSituation!ft_QtComplete = Now() " & _
"WHERE (td_QuoteSituation!bwk_Enquiry) = " & EnquiryID
db.Execute strSQL, dbFailOnError
strSQL = "SELECT * FROM td_Enquiry WHERE bwk_Enquiry = " & EnquiryID
Set rst = db.OpenRecordset(strSQL)
blnQuoted = DLookup("Quoted", "td_Enquiry", "bwk_Enquiry = " & EnquiryID) '"bwk_Filelist = " & lngFileId)
If blnQuoted = False 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
db.Execute strSQL, dbFailOnError
End If
End If


End If


rst.Close
Set rst = Nothing

Call ClearUserTempLog ' this just sets some form fields in Access to "" eg Forms!frmUserLog!txtContactID = ""
db.Close
Set db = Nothing

ws.Close
Set ws = Nothing

Set dbEng = Nothing

End Sub