Hi,
I have to tryed to rewrite this code on pure VBA with using
of API functions see my example
Make sure that in VBEditor ->Tools->Options->General
was checked "Break on Unhandled Errors" button
Feel free to adapt it to your suit
Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Any) As Long
Const WT_SLEEP = 2500
Const WM_CLOSE = &H10
Const WM_ACTIVATEAPP = &H1C
Const WM_USER = 1024
Const gcClassnameMSExcel = "XLMAIN"
Sub TestExcelQuit()
Dim xlApp As Object
Dim xlBook As Object
Dim xlSheet As Object
Dim hwnd As Long
Dim WhatD As Long
On Error Resume Next
Set xlApp = Nothing
Set xlApp = GetObject(, "Excel.Application")
If Err.Number 0 Then 'read this line as If Err.Number not equal zero
'because this symbol not shown correctly in this code
'I don't know why
Set xlApp = CreateObject("Excel.Application")
End If
Err.Clear
On Error GoTo Err_Control
MsgBox "Sleep 2.5 seconds"
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.worksheets(1)
xlSheet.Application.Visible = True
Sleep WT_SLEEP ' pause 2.5 sec
xlBook.Close Savechanges:=False
Set xlSheet = Nothing
Set xlBook = Nothing
hwnd = FindWindow(gcClassnameMSExcel, 0)
Do While hwnd > 0
'WhatD = SendMessage(hwnd, WM_USER + 18, 0, ByVal 0&) ' Microsoft Excel 95
WhatD = SendMessage(hwnd, WM_ACTIVATEAPP, 0, ByVal 0&) ' Microsoft Office 2000 or Microsoft Office XP
'Set xlApp = GetObject(, "Excel.Application")
xlApp.Quit
hwnd = FindWindow(gcClassnameMSExcel, 0)
Loop
Set xlApp = Nothing
Err_Control:
If Err Then
MsgBox Err.Description
Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
End If
End Sub
Fatty
~'J'~
Message was edited by: Fatty
