Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
getting extra excel instance when controlling from access VBA
I am writing a program in Access VBA to create an excel spreadsheet, import
data into it from Access queries, and format it. It works fine until I tried putting a drop down list into it for data validation. Even that works, but I am left with an instance of Excel in the task manager even though the workbook has been closed and both the xlapp and xlworkbook has been set to nothing. I can't even terminate the instance using a version of this code that has only the get object parts and the close and set to nothing parts. It recogizes that excel is open, grabs it; then when you do application.quit and set to nothing, it just sits there in the task manager. Nothing seems to stop it. Variations of this have been plaguing me for days. Please help. 'form module with 2 buttons, one which is not being used. Another form is in db, but also not being used Option Compare Database Option Explicit Dim xlsAppTest As Excel.Application Dim xlsWorkbook As Excel.Workbook Private Sub Command11_Click() '************ Code Start ********** Dim objXL As Object Dim strWhat As String, boolXL As Boolean Dim objActiveWkb As Object If fIsAppRunning("Excel") Then Set objXL = GetObject(, "Excel.Application") boolXL = False Else Set objXL = CreateObject("Excel.Application") boolXL = True End If objXL.Application.Workbooks.Add Set objActiveWkb = objXL.Application.ActiveWorkbook With objActiveWkb .Worksheets(1).Cells(1, 1) = "Hello World" strWhat = .Worksheets(1).Cells(1, 1).Value End With objXL.Visible = True Stop FormatTest objXL Reason_PSYS objXL objActiveWkb.Close savechanges:=True, FileName:="test" & Str(10120602) If boolXL Then objXL.Application.Quit objXL.Application.Quit Set objActiveWkb = Nothing: Set objXL = Nothing MsgBox strWhat End Sub '************ Code End ********** 'module called Miscellaneous - nothing else here - works fine Public Sub FormatTest(xlsApp As Excel.Application) With xlsApp .Workbooks(1).Sheets(2).Range("A1:D1").Interior.Co lorIndex = 39 .Workbooks(1).Sheets(2).Range("A1:D1").Interior.Pa ttern = xlSolid .Workbooks(1).Sheets(2).Range("A1:D1").Interior.Pa tternColorIndex = xlAutomatic End With End Sub 'mod_Reason_PSYS - a general modul 'Option Explicit Dim xlApp As Excel.Application Sub Reason_PSYS(ByVal xlApp As Excel.Application) 'Sub Reason_PSYS() ' ' On Error GoTo Error_Handler Dim i As Long Dim f As Long 'xlapp.Workbooks(1).Sheets(2).Range("A1:D1").Borde rs(xlInsideVertical).ColorIndex = xlAutomatic For i = 1 To 195 xlApp.Workbooks(1).Sheets(1).Cells(i, 1).Value = "Test" Next i xlApp.Workbooks(1).Sheets(1).Range("BA2").Value = "CORRECT" xlApp.Workbooks(1).Sheets(1).Range("BA3").Value = "ERROR" xlApp.Workbooks(1).Sheets(1).Range("BA4").Value = "EXCEPTION" xlApp.Workbooks(1).Worksheets(2).Activate xlApp.Workbooks(1).Worksheets(2).Range("A2").Selec t xlApp.ActiveWindow.FreezePanes = True xlApp.Workbooks(1).Worksheets(1).Activate xlApp.Workbooks(1).Worksheets(1).Range("A2").Selec t xlApp.ActiveWindow.FreezePanes = True xlApp.Workbooks(1).Worksheets(1).Activate xlApp.Workbooks(1).Sheets(1).Range("O2").Select With xlApp.Workbooks(1).Sheets(1).Range("P2").Validatio n ', Cells(f, 16) .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ xlBetween, Formula1:="=$Ba$2:$BA$4" .IgnoreBlank = True InCellDropdown = True InputTitle = "" .ErrorTitle = "" .InputMessage = "" .ErrorMessage = "" .ShowInput = True .ShowError = True End With Stop With xlApp.Selection.Validation .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ xlBetween, Formula1:="=$BA$2:$BA$4" .IgnoreBlank = True .InCellDropdown = True .InputTitle = "" .ErrorTitle = "" .InputMessage = "" .ErrorMessage = "" .ShowInput = True .ShowError = True End With f = FindLastRow(xlApp) xlApp.Workbooks(1).Worksheets(1).Activate xlApp.Workbooks(1).Sheets(1).Cells(2, 16).Select xlApp.Selection.Copy For i = 3 To f xlApp.Workbooks(1).Sheets(1).Cells(i, 16).Select xlApp.ActiveSheet.Paste 'xlApp.Workbooks(1).Worksheets(2).Paste 'xlApp.Workbooks(1).Worksheets.Select Next i xlApp.Workbooks(1).Sheets(1).Range("O1").Value = "REASON" xlApp.Workbooks(1).Sheets(1).Range("P1").Value = "COMMENTS" xlApp.Workbooks(1).Sheets(1).Columns("P:P").Column Width = 31.29 xlApp.Workbooks(1).Sheets(1).Columns("O:P").Interi or.ColorIndex = 38 xlApp.Workbooks(1).Sheets(1).Columns("O:P").Interi or.Pattern = xlSolid 'Selection.Locked = False 'Selection.FormulaHidden = False Exit_Handler: Exit Sub Error_Handler: Debug.Print "Error: " & Err.Number & " " & Err.Description Stop Resume Next Resume Resume Exit_Handler End Sub Function FindLastRow(ByVal xlApp As Excel.Application) Dim LastRow As Long 'If xlApp.Workbooks(1).Sheets(1).WorksheetFunction.Cou nt(Cells) 0 Then 'xlApp.WorksheetFunction.Count (Cells) If xlApp.WorksheetFunction.CountA(Cells) 0 Then 'Search for any entry, by searching backwards by Rows. LastRow = xlApp.Workbooks(1).Sheets(1).Cells.Find(What:="*", After:=[A1], _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious).Row 'MsgBox LastRow End If FindLastRow = LastRow End Function 'Module IsAppRunning Option Compare Database '***************** 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 **************** |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
getting extra excel instance when controlling from access VBA
documented bug in this from MS
something about refering to second isnstance and using With With objActiveWkb try writing it all aout without with... "Duane Wilson" wrote: I am writing a program in Access VBA to create an excel spreadsheet, import data into it from Access queries, and format it. It works fine until I tried putting a drop down list into it for data validation. Even that works, but I am left with an instance of Excel in the task manager even though the workbook has been closed and both the xlapp and xlworkbook has been set to nothing. I can't even terminate the instance using a version of this code that has only the get object parts and the close and set to nothing parts. It recogizes that excel is open, grabs it; then when you do application.quit and set to nothing, it just sits there in the task manager. Nothing seems to stop it. Variations of this have been plaguing me for days. Please help. 'form module with 2 buttons, one which is not being used. Another form is in db, but also not being used Option Compare Database Option Explicit Dim xlsAppTest As Excel.Application Dim xlsWorkbook As Excel.Workbook Private Sub Command11_Click() '************ Code Start ********** Dim objXL As Object Dim strWhat As String, boolXL As Boolean Dim objActiveWkb As Object If fIsAppRunning("Excel") Then Set objXL = GetObject(, "Excel.Application") boolXL = False Else Set objXL = CreateObject("Excel.Application") boolXL = True End If objXL.Application.Workbooks.Add Set objActiveWkb = objXL.Application.ActiveWorkbook With objActiveWkb .Worksheets(1).Cells(1, 1) = "Hello World" strWhat = .Worksheets(1).Cells(1, 1).Value End With objXL.Visible = True Stop FormatTest objXL Reason_PSYS objXL objActiveWkb.Close savechanges:=True, FileName:="test" & Str(10120602) If boolXL Then objXL.Application.Quit objXL.Application.Quit Set objActiveWkb = Nothing: Set objXL = Nothing MsgBox strWhat End Sub '************ Code End ********** 'module called Miscellaneous - nothing else here - works fine Public Sub FormatTest(xlsApp As Excel.Application) With xlsApp .Workbooks(1).Sheets(2).Range("A1:D1").Interior.Co lorIndex = 39 .Workbooks(1).Sheets(2).Range("A1:D1").Interior.Pa ttern = xlSolid .Workbooks(1).Sheets(2).Range("A1:D1").Interior.Pa tternColorIndex = xlAutomatic End With End Sub 'mod_Reason_PSYS - a general modul 'Option Explicit Dim xlApp As Excel.Application Sub Reason_PSYS(ByVal xlApp As Excel.Application) 'Sub Reason_PSYS() ' ' On Error GoTo Error_Handler Dim i As Long Dim f As Long 'xlapp.Workbooks(1).Sheets(2).Range("A1:D1").Borde rs(xlInsideVertical).ColorIndex = xlAutomatic For i = 1 To 195 xlApp.Workbooks(1).Sheets(1).Cells(i, 1).Value = "Test" Next i xlApp.Workbooks(1).Sheets(1).Range("BA2").Value = "CORRECT" xlApp.Workbooks(1).Sheets(1).Range("BA3").Value = "ERROR" xlApp.Workbooks(1).Sheets(1).Range("BA4").Value = "EXCEPTION" xlApp.Workbooks(1).Worksheets(2).Activate xlApp.Workbooks(1).Worksheets(2).Range("A2").Selec t xlApp.ActiveWindow.FreezePanes = True xlApp.Workbooks(1).Worksheets(1).Activate xlApp.Workbooks(1).Worksheets(1).Range("A2").Selec t xlApp.ActiveWindow.FreezePanes = True xlApp.Workbooks(1).Worksheets(1).Activate xlApp.Workbooks(1).Sheets(1).Range("O2").Select With xlApp.Workbooks(1).Sheets(1).Range("P2").Validatio n ', Cells(f, 16) .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ xlBetween, Formula1:="=$Ba$2:$BA$4" .IgnoreBlank = True InCellDropdown = True InputTitle = "" .ErrorTitle = "" .InputMessage = "" .ErrorMessage = "" .ShowInput = True .ShowError = True End With Stop With xlApp.Selection.Validation .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ xlBetween, Formula1:="=$BA$2:$BA$4" .IgnoreBlank = True .InCellDropdown = True .InputTitle = "" .ErrorTitle = "" .InputMessage = "" .ErrorMessage = "" .ShowInput = True .ShowError = True End With f = FindLastRow(xlApp) xlApp.Workbooks(1).Worksheets(1).Activate xlApp.Workbooks(1).Sheets(1).Cells(2, 16).Select xlApp.Selection.Copy For i = 3 To f xlApp.Workbooks(1).Sheets(1).Cells(i, 16).Select xlApp.ActiveSheet.Paste 'xlApp.Workbooks(1).Worksheets(2).Paste 'xlApp.Workbooks(1).Worksheets.Select Next i xlApp.Workbooks(1).Sheets(1).Range("O1").Value = "REASON" xlApp.Workbooks(1).Sheets(1).Range("P1").Value = "COMMENTS" xlApp.Workbooks(1).Sheets(1).Columns("P:P").Column Width = 31.29 xlApp.Workbooks(1).Sheets(1).Columns("O:P").Interi or.ColorIndex = 38 xlApp.Workbooks(1).Sheets(1).Columns("O:P").Interi or.Pattern = xlSolid 'Selection.Locked = False 'Selection.FormulaHidden = False Exit_Handler: Exit Sub Error_Handler: Debug.Print "Error: " & Err.Number & " " & Err.Description Stop Resume Next Resume Resume Exit_Handler End Sub Function FindLastRow(ByVal xlApp As Excel.Application) Dim LastRow As Long 'If xlApp.Workbooks(1).Sheets(1).WorksheetFunction.Cou nt(Cells) 0 Then 'xlApp.WorksheetFunction.Count (Cells) If xlApp.WorksheetFunction.CountA(Cells) 0 Then 'Search for any entry, by searching backwards by Rows. LastRow = xlApp.Workbooks(1).Sheets(1).Cells.Find(What:="*", After:=[A1], _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious).Row 'MsgBox LastRow End If FindLastRow = LastRow End Function 'Module IsAppRunning Option Compare Database '***************** 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 **************** |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Controlling Access with Excel VBA | Excel Programming | |||
How do I access a variable from another instance of excel? | Excel Programming | |||
Access 2002 VB Module controlling Excel 2002 spreadsheet -Run-time | Excel Programming | |||
Controlling Access from Excel | Excel Programming |