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.Applicati on
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_Or der_Update.xlt"
Const conSHT_NAME = "Open Orders"

Set objXL = Excel.Applicati on

objXL.Applicati on.DisplayAlert s = False

'*** Return Database object pointing to current database.
Set dbs = CurrentDb
'*** Get predefined QueryDef.
Set qdfSupplierCode =
dbs.QueryDefs!q ry_Unique_Suppl ier_with_Open_O rders
'*** 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!q ry_Open_Order_U pdate_Report
qdfSupplierData .Parameters!str SupplierCode = 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.Workshee ts(conSHT_NAME)
If Not Err.Number = 0 Then
Set objSht = objWkb.Workshee ts.Add
objSht.Name = conSHT_NAME
End If
Err.Clear
On Error GoTo 0
intLastCol = objSht.UsedRang e.Columns.Count
With objSht
.Activate
.Range(.Cells(4 , 1), .Cells(conMAX_R OWS, _
intLastCol)).Cl earContents
.Range("A4").Co pyFromRecordset rsSupplierData
.Range("A2").Va lue = "Supplier Code: " & strCode & "
Supplier Name: " & strName
.Range("A4").Se lect
End With
End With

objXL.ActiveWor kbook.SaveAs FileName:="C:\" & strCode &
".xls", _
FileFormat:=xlN ormal, Password:="", WriteResPasswor d:="",
_
ReadOnlyRecomme nded:=False, CreateBackup:=F alse

rsSupplierCode. MoveNext
Next intCodeCounter
objXL.Applicati on.Quit
objXL.Applicati on.DisplayAlert s = 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*******@comp userve.com> wrote in message
news:82******** *************** **@posting.goog le.com...

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.Applicati on
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_Or der_Update.xlt"
Const conSHT_NAME = "Open Orders"

Set objXL = Excel.Applicati on

objXL.Applicati on.DisplayAlert s = False

'*** Return Database object pointing to current database.
Set dbs = CurrentDb
'*** Get predefined QueryDef.
Set qdfSupplierCode =
dbs.QueryDefs!q ry_Unique_Suppl ier_with_Open_O rders
'*** 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!q ry_Open_Order_U pdate_Report
qdfSupplierData .Parameters!str SupplierCode = 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.Workshee ts(conSHT_NAME)
If Not Err.Number = 0 Then
Set objSht = objWkb.Workshee ts.Add
objSht.Name = conSHT_NAME
End If
Err.Clear
On Error GoTo 0
intLastCol = objSht.UsedRang e.Columns.Count
With objSht
.Activate
.Range(.Cells(4 , 1), .Cells(conMAX_R OWS, _
intLastCol)).Cl earContents
.Range("A4").Co pyFromRecordset rsSupplierData
.Range("A2").Va lue = "Supplier Code: " & strCode & "
Supplier Name: " & strName
.Range("A4").Se lect
End With
End With

objXL.ActiveWor kbook.SaveAs FileName:="C:\" & strCode &
".xls", _
FileFormat:=xlN ormal, Password:="", WriteResPasswor d:="",
_
ReadOnlyRecomme nded:=False, CreateBackup:=F alse

rsSupplierCode. MoveNext
Next intCodeCounter
objXL.Applicati on.Quit
objXL.Applicati on.DisplayAlert s = 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.Applicati on
To:
Set objXL = New Excel.Applicati on

There are alos other issues. I would not try to do anything with
objXL.Applicati on 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("E xcel.Applicatio n")