Rocky Smolin at Beach Access Software
rockysmolin at bchacc.com
Wed Aug 8 10:43:31 CDT 2007
Do you set any other object in PrepExcel that might be left open?
Rocky
-----Original Message-----
From: accessd-bounces at databaseadvisors.com
[mailto:accessd-bounces at databaseadvisors.com] On Behalf Of ewaldt at gdls.com
Sent: Wednesday, August 08, 2007 8:30 AM
To: accessd at databaseadvisors.com
Subject: [AccessD] Correctly Closing Excel
In running the code below, I find that Excel does not completely exit, as
evidenced by Task Manager/Processes.
I've either neglected something, or I've done something out of order.
Could someone tell me my mistake, please?
Thanks. I've been struggling with this for a while now.
Thomas F. Ewald
Stryker Mass Properties
General Dynamics Land Systems
---------------------------------------------------------------
Sub PrepData()
Dim xlApp As Excel.Application
Dim xlWB As Excel.Workbook
Set xlApp = CreateObject("Excel.Application")
'Open Excel workbook
Set xlWB = xlApp.Workbooks.Open(strFileName) 'opens file
DoCmd.SetWarnings False
'Prep Excel workbook
PrepExcel
'Empty Clipboard before closing workbook
xlApp.CutCopyMode = False
'Shut down Excel
xlWB.Close savechanges:=True
Set xlWB = Nothing
xlApp.Quit
Set xlApp = Nothing
DoCmd.SetWarnings True
End Sub
---------------------------------------------------------------------
In case it's the PrepExcel sub that's causing the problem, here it is:
---------------------------------------------------------------------
Sub PrepExcel()
Dim intNewRow As Integer
Dim oCell As Object
Sheets.Add
Sheets("Sheet1").Name = "ToImport"
Sheets("ToImport").Select
'Copy only rows where column B = "A"
intNewRow = 1
For Each oCell In Sheets("GDLS-SHC").Range("B1:B200")
If oCell.Formula = "A" Then
oCell.EntireRow.Copy
ActiveSheet.Paste
Destination:=Worksheets("ToImport").Range("A" & intNewRow)
intNewRow = intNewRow + 1
End If
Next oCell
For Each oCell In Sheets("GDLS-C").Range("B1:B200")
If oCell.Formula = "A" Then
oCell.EntireRow.Copy
ActiveSheet.Paste
Destination:=Worksheets("ToImport").Range("A" & intNewRow)
intNewRow = intNewRow + 1
End If
Next oCell
'Check for non-numeric in Pounds and Grams
intNewRow = intNewRow - 1
For Each oCell In Sheets("ToImport").Range("C1:D" & intNewRow)
If Not IsNumeric(oCell.Formula) Then
oCell.Formula = 0
End If
Next oCell
For Each oCell In Sheets("ToImport").Range("C1:C" & intNewRow)
oCell.Formula = oCell.Formula + Range("D" & oCell.Row).Formula *
2.205 / 1000
Next oCell
End Sub
----------------------------------------------------------
Thomas F. Ewald
Stryker Mass Properties
General Dynamics Land Systems
This is an e-mail from General Dynamics Land Systems. It is for the intended
recipient only and may contain confidential and privileged information. No
one else may read, print, store, copy, forward or act in reliance on it or
its attachments. If you are not the intended recipient, please return this
message to the sender and delete the message and any attachments from your
computer. Your cooperation is appreciated.
--
AccessD mailing list
AccessD at databaseadvisors.com
http://databaseadvisors.com/mailman/listinfo/accessd
Website: http://www.databaseadvisors.com
No virus found in this incoming message.
Checked by AVG Free Edition.
Version: 7.5.476 / Virus Database: 269.11.8/941 - Release Date: 8/7/2007
4:06 PM