Closing Excel process (1 Viewer)

[KirkComer]

Hi All,

I recently ran into a problem with closing excel. This code has worked for over a year running 5 times a day with no problem. Recently Mircosoft office and XP SP3 updates came through on my PC. Now the code will not close my excel process.

I am using Access 2007 and Windows XP SP3

Thanks,
Kirk


Dim cnn As ADODB.Connection
Set cnn = CurrentProject.Connection
Dim MyRecordset As New ADODB.Recordset
Dim MyRecordset2 As New ADODB.Recordset
MyRecordset.ActiveConnection = cnn

Dim MySQL As String
Dim MySQL2 As String



DoCmd.SetWarnings True



MySQL = "Select * FROM [DPC Completed Forecast];"

MyRecordset.Open MySQL

Dim MySheetPath As String


MySheetPath = "T:\Database\DPC\Completed DPC Forecast.xlsx"
'MySheetPath = MySheetPath + "\Sheet1.xls"

Dim X1 As Excel.Application
Dim X1Book As Excel.Workbook
Dim X1Sheet As Excel.Worksheet

Set X1 = CreateObject("Excel.Application")
Set X1Book = GetObject(MySheetPath)

X1.Visible = True
X1Book.Windows(1).Visible = True

Set X1Sheet = X1Book.Worksheets(1)

X1Sheet.Range("A2", "D1000").Clear

X1Sheet.Range("A2").CopyFromRecordset MyRecordset

X1.ActiveWorkbook.Save
X1.Quit

MyRecordset.Close
Set cnn = Nothing
Set X1 = Nothing
Set X1Sheet = Nothing

DoCmd.Hourglass False

'DoCmd.CloseDatabase
DoCmd.Quit

End Sub

 

[vbaInet]

Close the workbook and that should kill the session:

Dim X1 As Excel.Application
Dim X1Book As Excel.Workbook
Dim X1Sheet As Excel.Worksheet

Set X1 = CreateObject("Excel.Application")
Set X1Book = X1.Workbooks.Open(MySheetPath)
'Set X1Book = GetObject(MySheetPath)
Set X1Sheet = X1Book.ActiveSheet

X1Sheet.Range("A2", "D1000").Clear
X1Sheet.Range("A2").CopyFromRecordset MyRecordset

X1.Visible = True
'X1Book.Windows(1).Visible = True

X1Book.Save
'X1.ActiveWorkbook.Save
X1Book.Close
X1.Quit

Set X1Sheet = Nothing
Set X1Book = Nothing
Set X1 = Nothing

I've also made some changes to your code.

Before you deploy your application I would advise that you use late binding if you're going to be using CreateObject(). Late binding means declare all three variables as Object.

 

[KirkComer]

Works great except EXCEL.EXE is still showing in Windows Task Manager "Processes".

 

[vbaInet]

That's probably an old process still lingering around.

Follow exactly these steps:

Kill the Excel session, save your db, Debug > Compile, Compact & Repair your database.

Now re-run the code again.

 

[KirkComer]

Just followed your instructions. I also rebooted the computer. I'm getting a EXCEL.EXE process each time I run the code. If I run the code 20 times excel open and closes fine (which is better than before) but I will end up with 20 EXCEL.EXE processes.

Here is the code... maybe I still have something wrong.

Dim cnn As ADODB.Connection
Set cnn = CurrentProject.Connection
Dim MyRecordset As New ADODB.Recordset
Dim MyRecordset2 As New ADODB.Recordset
MyRecordset.ActiveConnection = cnn

Dim MySQL As String
Dim MySQL2 As String



DoCmd.SetWarnings True



MySQL = "Select * FROM [DPC Completed Forecast];"

MyRecordset.Open MySQL

Dim MySheetPath As String


MySheetPath = "T:\Database\DPC\Completed DPC Forecast.xlsx"
'MySheetPath = MySheetPath + "\Sheet1.xls"

'Dim X1 As Excel.Application
'Dim X1Book As Excel.Workbook
'Dim X1Sheet As Excel.Worksheet

'Set X1 = CreateObject("Excel.Application")
'Set X1Book = GetObject(MySheetPath)

'X1.Visible = True
'X1Book.Windows(1).Visible = True

'Set X1Sheet = X1Book.Worksheets(1)

'X1Sheet.Range("A2", "D1000").Clear

'X1Sheet.Range("A2").CopyFromRecordset MyRecordset

'X1.ActiveWorkbook.Save
'X1.Quit

'MyRecordset.Close
'Set cnn = Nothing
'Set X1 = Nothing
'Set X1Sheet = Nothing

'''Start Code from vbaInet'''
Dim X1 As Excel.Application
Dim X1Book As Excel.Workbook
Dim X1Sheet As Excel.Worksheet

Set X1 = CreateObject("Excel.Application")
Set X1Book = X1.Workbooks.Open(MySheetPath)
'Set X1Book = GetObject(MySheetPath)
Set X1Sheet = X1Book.ActiveSheet

X1Sheet.Range("A2", "D1000").Clear
X1Sheet.Range("A2").CopyFromRecordset MyRecordset

X1.Visible = True
'X1Book.Windows(1).Visible = True

X1Book.Save
'X1.ActiveWorkbook.Save
X1Book.Close
X1.Quit

Set X1Sheet = Nothing
Set X1Book = Nothing
Set X1 = Nothing
'''End Code from vbaInet'''

DoCmd.Hourglass False

'DoCmd.CloseDatabase
DoCmd.Quit

End Sub

 

[vbaInet]

Comment out the DoCmd.Quite code line and try it again. Remember to kill the process before running it.

 

[KirkComer]

Same result. Still adds the EXCEL.EXE process.
Only thing changed was Access didn't close.

 

[KirkComer]

One of the microsoft updates was the addition of microsoft office live to my computer. I wonder if that had anything to do with it?

 

[vbaInet]

Alright, let's stop mixing late and early binding. Change the declarations to this:

    Dim X1 As [COLOR=Red]Object[/COLOR]
    Dim X1Book As [COLOR=Red]Object[/COLOR]
    Dim X1Sheet As [COLOR=Red]Object[/COLOR]

Again, remember to kill the process before running the code.

 

[Kiwiman]

Howzit

I have used this in the past to see if the application is runnng then dependent on the result either create or get the object

    If fIsAppRunning("Excel") Then
        Set X1= GetObject(, "Excel.Application")
       
    Else
        Set xlApp = CreateObject("Excel.Application")
    End If[B][/B]

Option Compare Database
Option Explicit

'***************** Code Start ***************
'This code was originally written by Dev Ashish.
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
'Code Courtesy of
'Dev Ashish
'
Private Const SW_HIDE = 0
Private Const SW_SHOWNORMAL = 1
Private Const SW_NORMAL = 1
Private Const SW_SHOWMINIMIZED = 2
Private Const SW_SHOWMAXIMIZED = 3
Private Const SW_MAXIMIZE = 3
Private Const SW_SHOWNOACTIVATE = 4
Private Const SW_SHOW = 5
Private Const SW_MINIMIZE = 6
Private Const SW_SHOWMINNOACTIVE = 7
Private Const SW_SHOWNA = 8
Private Const SW_RESTORE = 9
Private Const SW_SHOWDEFAULT = 10
Private Const SW_MAX = 10

Private Declare Function apiFindWindow Lib "user32" Alias _
                                       "FindWindowA" (ByVal strClass As String, _
                                                      ByVal lpWindow As String) As Long

Private Declare Function apiSendMessage Lib "user32" Alias _
                                        "SendMessageA" (ByVal Hwnd As Long, ByVal Msg As Long, ByVal _
                                                                                               wParam As Long, lParam As Long) As Long

Private Declare Function apiSetForegroundWindow Lib "user32" Alias _
                                                "SetForegroundWindow" (ByVal Hwnd As Long) As Long

Private Declare Function apiShowWindow Lib "user32" Alias _
                                       "ShowWindow" (ByVal Hwnd As Long, ByVal nCmdShow As Long) As Long

Private Declare Function apiIsIconic Lib "user32" Alias _
                                     "IsIconic" (ByVal Hwnd As Long) As Long

Function fIsAppRunning(ByVal strAppName As String, _
                       Optional fActivate As Boolean) As Boolean
    Dim lngH As Long, strClassName As String
    Dim lngX As Long, lngTmp As Long
    Const WM_USER = 1024
    On Local Error GoTo fIsAppRunning_Err
    fIsAppRunning = False
    Select Case LCase$(strAppName)
        Case "excel": strClassName = "XLMain"
        Case "word": strClassName = "OpusApp"
        Case "access": strClassName = "OMain"
        Case "powerpoint95": strClassName = "PP7FrameClass"
        Case "powerpoint97": strClassName = "PP97FrameClass"
        Case "notepad": strClassName = "NOTEPAD"
        Case "paintbrush": strClassName = "pbParent"
        Case "wordpad": strClassName = "WordPadClass"
        Case Else: strClassName = vbNullString
    End Select

    If strClassName = "" Then
        lngH = apiFindWindow(vbNullString, strAppName)
    Else
        lngH = apiFindWindow(strClassName, vbNullString)
    End If
    If lngH <> 0 Then
        apiSendMessage lngH, WM_USER + 18, 0, 0
        lngX = apiIsIconic(lngH)
        If lngX <> 0 Then
            lngTmp = apiShowWindow(lngH, SW_SHOWNORMAL)
        End If
        If fActivate Then
            lngTmp = apiSetForegroundWindow(lngH)
        End If
        fIsAppRunning = True
    End If
fIsAppRunning_Exit:
    Exit Function
fIsAppRunning_Err:
    fIsAppRunning = False
    Resume fIsAppRunning_Exit
End Function
'******************** Code End ****************

 

[vbaInet]

Kiwiman, good code. I'm actually aware of this code but the problem isn't about creating an excel instance or using an instance that already exists. The problem is the created and closed instance should not persist.

It's better to get that fixed and if all else fails provide a band aid fix.

 

[KirkComer]

vbaInet,
Made the change but same exact result. I always close out all the EXCEL.EXE before running the code.

 

[vbaInet]

Interesting because I don't get the same results.

Can you upload a test db.

 

[Kiwiman]

Howzit

I would love to know the answer \ cause as I had a similar problem a few years back that I could not get to the bottom of, hence the bandaid.

 

[vbaInet]

Howzit

I would love to know the answer \ cause as I had a similar problem a few years back that I could not get to the bottom of, hence the bandaid.

It must be something lingering around somewhere. If I can get the db we'll take a look.

 

[vbaInet]

By the way KirkComer:

1. what OS are you using?
2. what version of Access and Excel are you using?

 

[KirkComer]

Its got linked tables (so it won't work) but I could maybe just make them into regular access tables if needed for you to test. I'm sure its something from the new updates because I haven't had this kind of trouble since I started using the code over a year ago.

 

[KirkComer]

XP Service Pack 3
Microsoft Access 2007
Microsoft Excel 2007

 

[vbaInet]

Drop a local table on there so I can CopyFromRecordset, then upload it. I just need test data, nothing confidential.

 

[KirkComer]

vbaInet,
I removed everything except what is necessary to do the excel dump. All you have to do is open the "testform" and the code will run. I still have the same problem. I just tested it on another computer and it worked fine with no processes left behind.

Kiwiman,
Give it a try and see how it does for you.