closing Excel Instance (1 Viewer)

[chewy]

I se automation to fill in data from Access into Excel to email to a customer. The automation works fine and it fills it in with the correct data. However the part that doesnt workquite right is closing Excel. I will keep an instance open in the Task Manager. So if the I try to ipen another Excel file or choose to export the file again it either hangs or it give me a Excel has generated errors and has to be closed error.

If you could look at this code and tell me where to put these lines

objXLWrkBk.Close SaveChanges:=True
objXL.Quit

Here is the whole thing


Private Sub Command4_Click()
Dim answer As String
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL As String
Dim objXL As Excel.Application
Dim objXLWrkBk As Excel.Workbook
Dim objXLWrkSht As Excel.Worksheet
Dim lngStartRange As Long
Dim myCount As Variant
Dim count As Integer

If StartDate > EndDate Then
MsgBox StartDate & " is after " & EndDate & vbCrLf & "Start date can not be after End date" & vbCrLf & vbCrLf & vbCrLf & "Change before you can proceed!", vbExclamation, "Date Error"
Else

strSQL = "SELECT * FROM qryMain WHERE Date BETWEEN #" & StartDate & "# AND #" & EndDate & "#"

Set db = CurrentDb
Set rs = db.OpenRecordset(strSQL)

If rs.BOF Then

'no records
Beep
MsgBox "There are no records for the dates entered!"
Else
Dim intI As Integer

For intI = 1 To 244 ' Start loop.
If intI Mod 25 = 0 Then ' If loop has repeated 100 times.
DoCmd.OpenForm "frmProcessing", acNormal, , , , acWindowNormal
DoEvents ' Yield to operating system.
End If
Next intI ' Increment loop counter.


myCount = DCount("[CustomerID]", "qryCount")

lngStartRange = 5 'start at row 5
Set objXL = CreateObject("Excel.Application")
Set objXLWrkBk = objXL.Workbooks.Open("M:\Book Keeping\Matt Majewski Procedures\Ferris Lockbox\Ferris Ind.xls")
Set objXLWrkSht = objXLWrkBk.Worksheets("Sheet1") 'takes the name of the tab in Excel in your case sheet1
objXLWrkSht.Range("A1").Activate

'starts at the 5th row
count = 5
'goes through rows 5 through 200
While count <> 200

'clears out the values in the particular column
objXL.Cells(lngStartRange, "A").Value = ""
objXL.Cells(lngStartRange, "B").Value = ""
objXL.Cells(lngStartRange, "C").Value = ""
objXL.Cells(lngStartRange, "D").Value = ""
objXL.Cells(lngStartRange, "E").Value = ""

With objXL
'makes the A column not not bold
.Range("A" & lngStartRange).Select
.Selection.Font.Bold = False
'makes the E column not bold
.Range("E" & lngStartRange).Select
.Selection.Font.Bold = False
End With

lngStartRange = lngStartRange + 1 'increment the row for next customer
'rs.MoveNext 'move to next customer
count = count + 1
Wend

'saves the spreadsheet
objXLWrkBk.Close SaveChanges:=True
'quits Excel
objXL.Quit

If rs.BOF Then
'no records
Beep
MsgBox "There were no records with the date range you specified!"

Else
lngStartRange = 5 'start at row 5
Set objXL = CreateObject("Excel.Application")
Set objXLWrkBk = objXL.Workbooks.Open("M:\Book Keeping\Matt Majewski Procedures\Ferris Lockbox\Ferris Ind.xls")
Set objXLWrkSht = objXLWrkBk.Worksheets("Sheet1") 'takes the name of the tab in Excel in your case sheet1
objXLWrkSht.Range("A1").Activate

While Not rs.EOF
'sets the specified row to the value of the row in Access
objXL.Cells(lngStartRange, "A").Value = rs("CustomerName").Value
objXL.Cells(lngStartRange, "B").Value = rs("CustomerNumber").Value
objXL.Cells(lngStartRange, "C").Value = rs("CheckNumber").Value
objXL.Cells(lngStartRange, "D").Value = rs("InvoiceNumber").Value
objXL.Cells(lngStartRange, "E").Value = rs("CheckAmount").Value

lngStartRange = lngStartRange + 1 'increment the row for next customer
rs.MoveNext 'move to next customer
Wend

StartDate.SetFocus
'prints the date of the value selected from ONLY the startdate textbox
objXL.Cells(1, "A").Value = Me.StartDate.Text
'inserts the word total into the last row
objXL.Cells(lngStartRange, "A").Value = "Total"
'inserts the total formula into the last row and column E
objXL.Cells(lngStartRange, "E").Value = "=SUM(E5:E" & (lngStartRange - 1) & ")"
With objXL
'sets column A(lastrow) to Bold
.Range("A" & lngStartRange).Select
.Selection.Font.Bold = True
'sets column E(lastrow) to Bold
.Range("E" & lngStartRange).Select
.Selection.Font.Bold = True
End With
'close the procesing form
DoCmd.Close acForm, "frmProcessing"
Beep
'confirm that you want to print the spreadsheets
answer = MsgBox("Do you really want to print two copies of date " & Me.StartDate & " ?", vbYesNo, "Confirm Print")
If answer = vbYes Then
ActiveSheet.PageSetup.PrintArea = ""
objXLWrkSht.PrintOut 1, 2, 2
'Beep
'MsgBox " PRINT OUT DONE!! "
objXLWrkBk.Close SaveChanges:=True
objXL.Quit

End If

On Error GoTo HandleErr:
answer = MsgBox("Do you want to open an email dialog?", vbYesNo, "Email spreadsheet?")
If answer = vbYes Then
Dim EmailApp, NameSpace, EmailSend As Object

Set EmailApp = CreateObject("Outlook.Application")
Set NameSpace = EmailApp.getNameSpace("MAPI")
Set EmailSend = EmailApp.CreateItem(0)

EmailSend.to = "mmajewski@alliancebankna.com" ' Put email address here
EmailSend.Subject = "Ferris Lockbox for " & Date
EmailSend.Body = "Wendy," & vbCrLf & vbCrLf & "Here is the Lockbox for today" & vbCrLf & vbCrLf
EmailSend.Attachments.Add "M:\Book Keeping\Matt Majewski Procedures\Ferris Lockbox\Ferris Ind.xls" ' Change this to match your path
EmailSend.Display ' Remove this line if you don't want to see email

Set EmailApp = Nothing
Set NameSpace = Nothing
Set EmailSend = Nothing
End If
End If
Done:
Set rs = Nothing
Set db = Nothing
Set objXL = Nothing
Set objXLWrkBk = Nothing
Set objXLWrkSht = Nothing


End If



'Call email
End If


ExitHere:
Exit Sub

HandleErr:
If Err.Number = 2501 Then
MsgBox "You decided to close the email form before you sent the email to Ferris! Make sure you send it ASAP!"
Resume ExitHere:
Else
MsgBox Err.Description & Err.Number
Resume ExitHere:
End If

End Sub

 

[Travis]

Change the section where you set you objects to nothing the following:


Move everything from under the "DONE:" Tag to the "EXITHERE:" Tag

ExitHere:
'If an Error occurs don't worry because the object does not exist
'and that is what we want.
On Error resume next
rs.Close
Set rs = Nothing
db.Close
Set db = Nothing
Set objXLWrkSht = Nothing
objXLWrkBk.Close
Set objXLWrkBk = Nothing
objXL.Quit
Set objXL = Nothing

 

[chewy]

that seemed to work but now it ask me to save the spreadsheet everytime.

 

[MisguidedMortal]

objXLWrkBk.Close True (If you want to save your changes)
objXLWrkBk.Close False (If your do not want to save your changes)

Otherwise it will keep asking you if you want to save your changes.


Hope this helps.