[AccessD] Correctly Closing Excel

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
 




More information about the AccessD mailing list