Hanging Excel Instance

[Rick Brown]

After reading 30+ threads on the subject and implementing pertinent
changes I still have an instance of Excel that won't close.
I hope its due to my poor coding and someone can spot the error.
I've used Dev Avish's code as a starting point and the Sub does what I
want less the hanging instance.

Please help if you can, Rick

Public Sub Email_Supplier()
Dim dbs As DATABASE
Dim qdfSupplierCode As QueryDef
Dim qdfSupplierData As QueryDef
Dim rsSupplierData As Recordset
Dim rsSupplierCode As Recordset
Dim varRecords As Variant
Dim Rcount As Integer
Dim intCodeCounter As Integer
Dim objXL As Excel.Application
Dim objWkb As Excel.Workbook
Dim objSht As Excel.Worksheet
Dim intLastCol As Integer
Dim strCode As String
Dim strName As String

Const conMAX_ROWS = 1000
Const conWKB_NAME = "C:\MSA_Open_Order_Update.xlt"
Const conSHT_NAME = "Open Orders"

Set objXL = Excel.Application

objXL.Application.DisplayAlerts = False

'*** Return Database object pointing to current database.
Set dbs = CurrentDb
'*** Get predefined QueryDef.
Set qdfSupplierCode =
dbs.QueryDefs!qry_Unique_Supplier_with_Open_Orders
'*** Open Recordset
Set rsSupplierCode = qdfSupplierCode.OpenRecordset

'*** Count records in recordset
rsSupplierCode.MoveLast
Rcount = rsSupplierCode.RecordCount
'*** Build Array
rsSupplierCode.MoveFirst
varRecords = rsSupplierCode.GetRows(Rcount)
rsSupplierCode.MoveFirst

For intCodeCounter = 0 To Rcount - 1
strCode = varRecords(0, intCodeCounter)
strName = varRecords(1, intCodeCounter)
'*** Get predefined QueryDef.
Set qdfSupplierData =
dbs.QueryDefs!qry_Open_Order_Update_Report
qdfSupplierData.Parameters!strSupplierCode = varRecords(0,
intCodeCounter)
'*** Open Recordset
Set rsSupplierData =
qdfSupplierData.OpenRecordset(dbOpenSnapshot)
'Load Excel Sheets
With objXL
Set objWkb = .Workbooks.Open(conWKB_NAME)
On Error Resume Next
Set objSht = objWkb.Worksheets(conSHT_NAME)
If Not Err.Number = 0 Then
Set objSht = objWkb.Worksheets.Add
objSht.Name = conSHT_NAME
End If
Err.Clear
On Error GoTo 0
intLastCol = objSht.UsedRange.Columns.Count
With objSht
.Activate
.Range(.Cells(4, 1), .Cells(conMAX_ROWS, _
intLastCol)).ClearContents
.Range("A4").CopyFromRecordset rsSupplierData
.Range("A2").Value = "Supplier Code: " & strCode & "
Supplier Name: " & strName
.Range("A4").Select
End With
End With

objXL.ActiveWorkbook.SaveAs FileName:="C:\" & strCode &
".xls", _
FileFormat:=xlNormal, Password:="", WriteResPassword:="",
_
ReadOnlyRecommended:=False, CreateBackup:=False

rsSupplierCode.MoveNext
Next intCodeCounter
objXL.Application.Quit
objXL.Application.DisplayAlerts = True

Set qdfSupplierCode = Nothing
Set rsSupplierCode = Nothing
Set qdfSupplierData = Nothing
Set rsSupplierData = Nothing
Set dbs = Nothing
Set objSht = Nothing
Set objWkb = Nothing
Set objXL = Nothing

End Sub

[Eric Schittlipz]

"Rick Brown" <rb*******@compuserve.com> wrote in message
news:82*************************@posting.google.co m...

After reading 30+ threads on the subject and implementing pertinent
changes I still have an instance of Excel that won't close.
I hope its due to my poor coding and someone can spot the error.
I've used Dev Avish's code as a starting point and the Sub does what I
want less the hanging instance.

Please help if you can, Rick

Public Sub Email_Supplier()
Dim dbs As DATABASE
Dim qdfSupplierCode As QueryDef
Dim qdfSupplierData As QueryDef
Dim rsSupplierData As Recordset
Dim rsSupplierCode As Recordset
Dim varRecords As Variant
Dim Rcount As Integer
Dim intCodeCounter As Integer
Dim objXL As Excel.Application
Dim objWkb As Excel.Workbook
Dim objSht As Excel.Worksheet
Dim intLastCol As Integer
Dim strCode As String
Dim strName As String

Const conMAX_ROWS = 1000
Const conWKB_NAME = "C:\MSA_Open_Order_Update.xlt"
Const conSHT_NAME = "Open Orders"

Set objXL = Excel.Application

objXL.Application.DisplayAlerts = False

'*** Return Database object pointing to current database.
Set dbs = CurrentDb
'*** Get predefined QueryDef.
Set qdfSupplierCode =
dbs.QueryDefs!qry_Unique_Supplier_with_Open_Orders
'*** Open Recordset
Set rsSupplierCode = qdfSupplierCode.OpenRecordset

'*** Count records in recordset
rsSupplierCode.MoveLast
Rcount = rsSupplierCode.RecordCount
'*** Build Array
rsSupplierCode.MoveFirst
varRecords = rsSupplierCode.GetRows(Rcount)
rsSupplierCode.MoveFirst

For intCodeCounter = 0 To Rcount - 1
strCode = varRecords(0, intCodeCounter)
strName = varRecords(1, intCodeCounter)
'*** Get predefined QueryDef.
Set qdfSupplierData =
dbs.QueryDefs!qry_Open_Order_Update_Report
qdfSupplierData.Parameters!strSupplierCode = varRecords(0,
intCodeCounter)
'*** Open Recordset
Set rsSupplierData =
qdfSupplierData.OpenRecordset(dbOpenSnapshot)
'Load Excel Sheets
With objXL
Set objWkb = .Workbooks.Open(conWKB_NAME)
On Error Resume Next
Set objSht = objWkb.Worksheets(conSHT_NAME)
If Not Err.Number = 0 Then
Set objSht = objWkb.Worksheets.Add
objSht.Name = conSHT_NAME
End If
Err.Clear
On Error GoTo 0
intLastCol = objSht.UsedRange.Columns.Count
With objSht
.Activate
.Range(.Cells(4, 1), .Cells(conMAX_ROWS, _
intLastCol)).ClearContents
.Range("A4").CopyFromRecordset rsSupplierData
.Range("A2").Value = "Supplier Code: " & strCode & "
Supplier Name: " & strName
.Range("A4").Select
End With
End With

objXL.ActiveWorkbook.SaveAs FileName:="C:\" & strCode &
".xls", _
FileFormat:=xlNormal, Password:="", WriteResPassword:="",
_
ReadOnlyRecommended:=False, CreateBackup:=False

rsSupplierCode.MoveNext
Next intCodeCounter
objXL.Application.Quit
objXL.Application.DisplayAlerts = True

Set qdfSupplierCode = Nothing
Set rsSupplierCode = Nothing
Set qdfSupplierData = Nothing
Set rsSupplierData = Nothing
Set dbs = Nothing
Set objSht = Nothing
Set objWkb = Nothing
Set objXL = Nothing

End Sub

Change:
Set objXL = Excel.Application
To:
Set objXL = New Excel.Application

There are alos other issues. I would not try to do anything with
objXL.Application after I had called .Quit apart from set it to nothing. I
would also set the objects to nothing in the reverse order to how they had
been created - so that you save, close and set to nothing the worksheet
object before setting the application object to nothing.

Other, issues are error handling which could be improved to make sure you do
your best to quit any hidden instance of Excel if your code started one.
And on that point, are you sure you always want to start a fresh instance of
Excel, even if the user already has Excel open. In fact you could
re-structure the code a bit so it had discrete functions called from within
the main sub to make error handling easier.

A final point to consider, is that if you are distributing this application
to other users (who may change their version of Office) you may be better
off using late binding and calling CreateObject("Excel.Application")