How to activate workbook exported from SAP? - excel

I have a macro to process data from SAP.
When the workbook from SAP appears I am not able to activate it via VBA code below.
Even Workbooks("export.xlsx").activate does not work.
session.findById("wnd[0]/tbar[0]/okcd").Text = "/nFBL3N"
session.findById("wnd[0]").sendVKey 0
session.findById("wnd[0]/usr/btn%_SD_SAKNR_%_APP_%-VALU_PUSH").press
session.findById("wnd[1]/usr/tabsTAB_STRIP/tabpSIVA/ssubSCREEN_HEADER:SAPLALDB:3010/tblSAPLALDBSINGLE/ctxtRSCSEL_255-SLOW_I[1,0]").Text = "179811"
session.findById("wnd[1]/usr/tabsTAB_STRIP/tabpSIVA/ssubSCREEN_HEADER:SAPLALDB:3010/tblSAPLALDBSINGLE/ctxtRSCSEL_255-SLOW_I[1,1]").Text = "431311"
session.findById("wnd[1]/usr/tabsTAB_STRIP/tabpSIVA/ssubSCREEN_HEADER:SAPLALDB:3010/tblSAPLALDBSINGLE/ctxtRSCSEL_255-SLOW_I[1,1]").SetFocus
session.findById("wnd[1]/usr/tabsTAB_STRIP/tabpSIVA/ssubSCREEN_HEADER:SAPLALDB:3010/tblSAPLALDBSINGLE/ctxtRSCSEL_255-SLOW_I[1,1]").caretPosition = 6
session.findById("wnd[1]/tbar[0]/btn[0]").press
session.findById("wnd[1]/tbar[0]/btn[8]").press
session.findById("wnd[0]/usr/radX_AISEL").Select
session.findById("wnd[0]/usr/ctxtSO_BUDAT-LOW").Text = "01.03.2020"
session.findById("wnd[0]/usr/ctxtSO_BUDAT-HIGH").Text = "31.03.2020"
session.findById("wnd[0]/usr/ctxtSO_BUDAT-HIGH").SetFocus
session.findById("wnd[0]/usr/ctxtSO_BUDAT-HIGH").caretPosition = 10
session.findById("wnd[0]/tbar[1]/btn[16]").press
session.findById("wnd[0]/usr/ssub%_SUBSCREEN_%_SUB%_CONTAINER:SAPLSSEL:2001/ssubSUBSCREEN_CONTAINER2:SAPLSSEL:2000/ssubSUBSCREEN_CONTAINER:SAPLSSEL:1106/ctxt%%DYN009-LOW").Text = "L6"
session.findById("wnd[0]/usr/ssub%_SUBSCREEN_%_SUB%_CONTAINER:SAPLSSEL:2001/ssubSUBSCREEN_CONTAINER2:SAPLSSEL:2000/ssubSUBSCREEN_CONTAINER:SAPLSSEL:1106/ctxt%%DYN009-LOW").SetFocus
session.findById("wnd[0]/usr/ssub%_SUBSCREEN_%_SUB%_CONTAINER:SAPLSSEL:2001/ssubSUBSCREEN_CONTAINER2:SAPLSSEL:2000/ssubSUBSCREEN_CONTAINER:SAPLSSEL:1106/ctxt%%DYN009-LOW").caretPosition = 2
session.findById("wnd[0]/tbar[1]/btn[8]").press
session.findById("wnd[0]/mbar/menu[0]/menu[3]/menu[1]").Select
session.findById("wnd[1]/tbar[0]/btn[11]").press
Set session = Nothing
Set Connection = Nothing
Set SapGuiAuto = Nothing
Set WScript = Nothing
Set Application = Nothing
Dim wb As Workbook
Windows("export.XLSX").Activate

In order to check the existence of the workbook in all open Excel sessions, please use the next code, as I will explain
Firstly copy the next code on top of your module (in the declarations part):
Option Explicit
#If VBA7 Then
Private Declare PtrSafe Function AccessibleObjectFromWindow Lib "oleacc" ( _
ByVal hWnd As LongPtr, ByVal dwId As Long, riid As Any, ppvObject As Object) As Long
Private Declare PtrSafe Function FindWindowExA Lib "user32" ( _
ByVal hwndParent As LongPtr, ByVal hwndChildAfter As LongPtr, _
ByVal lpszClass As String, ByVal lpszWindow As String) As LongPtr
#Else
Private Declare Function AccessibleObjectFromWindow Lib "oleacc" ( _
ByVal hwnd As Long, ByVal dwId As Long, riid As Any, ppvObject As Object) As Long
Private Declare Function FindWindowExA Lib "user32" ( _
ByVal hwndParent As Long, ByVal hwndChildAfter As Long, _
ByVal lpszClass As String, ByVal lpszWindow As String) As Long
#End If
Then, use the next function to be called from your existing code (instead of Windows("export.XLSX").Activate):
Private Function GetExcelSes() As Collection
Dim g&(0 To 3), ppv As Object, hWnd, hWnd2, hWnd3
g(0) = &H20400: g(1) = &H0
g(2) = &HC0: g(3) = &H46000000
Dim AlreadyThere As Boolean, Xl As Application
Set GetExcelSes = New Collection
Do
hWnd = FindWindowExA(0, hWnd, "XLMAIN", vbNullString)
If hWnd = 0 Then Exit Do
hWnd2 = FindWindowExA(hWnd, 0, "XLDESK", vbNullString)
hWnd3 = FindWindowExA(hWnd2, 0, "EXCEL7", vbNullString)
If AccessibleObjectFromWindow(hWnd3, &HFFFFFFF0, g(0), ppv) = 0 Then
AlreadyThere = False
For Each Xl In GetExcelSes
If Xl Is ppv.Application Then
AlreadyThere = True
Exit For
End If
Next
If Not AlreadyThere Then
GetExcelSes.aDD ppv.Application
End If
End If
Loop
End Function
The above function can be called as in the following example (use it like it is instead of your last code line). The declarations are important:
Sub TestSaveAWbFromAllSess()
Dim Ex As Collection, El As Variant
Dim wb As Workbook, expWb As Workbook
Set Ex = GetExcelSes
For Each El In Ex
For Each wb In El.Workbooks
Debug.Print wb.Name 'just to see all open wb names, confirming that the function works...
If UCase(wb.Name) = "EXPORT.XLSX" Then
Set expWb = wb
'Do here whatever you need with the found workbook. For instance:
expWb.SaveCopyAs fileName:=ThisWorkbook.path & "\TestSAPExport.XLSX"
End If
Next
Next
End Sub

Related

Importing Spreedsheet file from SAP GUI using Macro - VBA error 9 subscript out of range while using Workbooks.Close

I'm newbie into macros and VBA - but because specific of my work requires to learn about VBA and macros.
So I've recorded in SAP GUI code below.
File EXPORT.XLSX saves at destination and new EXPORT.XLSX opens itself - But I want to just save it at the destination - without opening it straight away (for that I have different code) - how to do it? Or how to close the EXPORT.XLSX - Workbooks("filenamewithpath").close doesn't work - I'm receiving Error Code 9 :/
Run-time error '9': Subscript out of range
Sub Pobierz_zle()
If Not IsObject(SApplication) Then
Set SapGuiAuto = GetObject("SAPGUI")
Set SApplication = SapGuiAuto.GetScriptingEngine
End If
If Not IsObject(Connection) Then
Set Connection = SApplication.Children(0)
End If
If Not IsObject(session) Then
Set session = Connection.Children(0)
End If
If IsObject(WScript) Then
WScript.ConnectObject session, "on"
WScript.ConnectObject SApplication, "on"
End If
session.findById("wnd[0]").maximize
session.findById("wnd[0]/tbar[0]/okcd").Text = "/n zle_stocklist"
session.findById("wnd[0]").sendVKey 0
session.findById("wnd[0]").sendVKey 0
session.findById("wnd[0]/usr/ctxt[0]").Text = "3901"
session.findById("wnd[0]/usr/ctxt[0]").caretPosition = 4
session.findById("wnd[0]").sendVKey 0
session.findById("wnd[0]/usr/ctxt[1]").Text = "3182"
session.findById("wnd[0]/usr/ctxt[1]").caretPosition = 4
session.findById("wnd[0]").sendVKey 0
session.findById("wnd[0]/usr/ctxt[3]").Text = "3500"
session.findById("wnd[0]/usr/ctxt[3]").SetFocus
session.findById("wnd[0]/usr/ctxt[3]").caretPosition = 4
session.findById("wnd[0]").sendVKey 0
session.findById("wnd[0]/usr/chk[0]").Selected = False
session.findById("wnd[0]/usr/chk[0]").SetFocus
session.findById("wnd[0]").sendVKey 0
session.findById("wnd[0]").sendVKey 8
session.findById("wnd[0]/usr/cntlCONTAINER_1/shellcont/shell").pressToolbarContextButton "&MB_EXPORT"
session.findById("wnd[0]/usr/cntlCONTAINER_1/shellcont/shell").selectContextMenuItem "&XXL"
session.findById("wnd[1]/usr/cmb").SetFocus
session.findById("wnd[1]/tbar[0]/btn[0]").press
session.findById("wnd[1]/usr/ctxt[0]").Text = "T:\DEPT-TSCW\WL\Inwentaryzacja\TEMP\"
session.findById("wnd[1]/usr/ctxt[1]").Text = "EXPORT.XLSX"
session.findById("wnd[1]/usr/ctxt[1]").caretPosition = 11
session.findById("wnd[1]").sendVKey 0
Application.Wait (Now + TimeValue("0:00:10"))
ActiveWorkbook.Close (False)
End Sub
Based on this entry you could try the following
Add the following declarations to a module
Option Explicit
' https://stackoverflow.com/a/68004477/6600940
#If VBA7 Then
Private Declare PtrSafe Function FindWindowEx Lib "User32" Alias _
"FindWindowExA" (ByVal hWnd1 As LongPtr, _
ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, _
ByVal lpsz2 As String) As LongPtr
Private Declare PtrSafe Function IIDFromString Lib "ole32" _
(ByVal lpsz As LongPtr, ByRef lpiid As GUID) As LongPtr
Private Declare PtrSafe Function AccessibleObjectFromWindow Lib "oleacc" _
(ByVal hWnd As LongPtr, ByVal dwId As LongPtr, ByRef riid As GUID, _
ByRef ppvObject As Object) As LongPtr
#Else
Private Declare Function FindWindowEx Lib "User32" Alias "FindWindowExA" _
(ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Long
Private Declare Function IIDFromString Lib "ole32" _
(ByVal lpsz As Long, ByRef lpiid As GUID) As Long
Private Declare Function AccessibleObjectFromWindow Lib "oleacc" _
(ByVal hWnd As Long, ByVal dwId As Long, ByRef riid As GUID, _
ByRef ppvObject As Object) As Long
#End If
Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type
Private Const S_OK As Long = &H0
Private Const IID_IDispatch As String = "{00020400-0000-0000-C000-000000000046}"
Private Const OBJID_NATIVEOM As Long = &HFFFFFFF0
As you have the name of the workbook you would like to close you can run the following code. It will counter-times look for that file and try to close it. It might be not the perfect solution but for me it works all the time. Whenever I donwload a file from SAP it will close the automatically opened file regardless wheter it was opened in the same instance or in another one
Sub runCloseWorkbook(wkbName As String, counter As Long)
Const MAX_TRIES As Long = 10
If closeWorkbook(wkbName) Then
Exit Sub
Else
counter = counter + 1
If counter <= MAX_TRIES Then
Application.OnTime Now + TimeValue("00:00:05"), "'runCloseWorkbook """ & wkbName & """,""" & counter & "'"
'Debug.Print "closeWorkbook", wkbName, counter
End If
End If
End Sub
For getting this to work you also need
Private Function closeWorkbook(wkbName As String) As Boolean
Dim hWinXL As Long
hWinXL = FindWindowEx(0&, 0&, "XLMAIN", vbNullString)
Dim xlApp As Excel.Application
Dim wb As Excel.Workbook
Do While hWinXL > 0
If getXLApp(hWinXL, xlApp) Then
For Each wb In xlApp.Workbooks
If wb.Name = wkbName Then
wb.Close False
closeWorkbook = True
' xlApp.Quit
End If
Next
End If
hWinXL = FindWindowEx(0, hWinXL, "XLMAIN", vbNullString)
Loop
End Function
' Private Function getXLApp(hWinXL As Long, xlApp As Excel.Application) As Boolean
Function getXLApp(hWinXL As Long, xlApp As Object) As Boolean
Dim hWinDesk As Long, hWin7 As Long
Dim obj As Object
Dim iid As GUID
Call IIDFromString(StrPtr(IID_IDispatch), iid)
hWinDesk = FindWindowEx(hWinXL, 0&, "XLDESK", vbNullString)
hWin7 = FindWindowEx(hWinDesk, 0&, "EXCEL7", vbNullString)
If AccessibleObjectFromWindow(hWin7, OBJID_NATIVEOM, iid, obj) = S_OK Then
Set xlApp = obj.Application
getXLApp = True
End If
End Function
In your case you could call it like that
runcloseworkbook "T:\DEPT-TSCW\WL\Inwentaryzacja\TEMP\EXPORT.XLSX", 5

Excel Workbook open status [duplicate]

I want to use something similar to
GetObject(,"Excel.Application") to get back the application I created.
I call CreateObject("Excel.Application") to create Excel instances. Later if the VBA project resets, due to debugging and coding, the Application object variables are lost but the Excel instances are running in the background. Kind of a memory leak situation.
I want to re-attach to either re-use (preferred way) or close them.
To list the running instances of Excel:
#If VBA7 Then
Private Declare PtrSafe Function AccessibleObjectFromWindow Lib "oleacc" ( _
ByVal hwnd As LongPtr, ByVal dwId As Long, riid As Any, ppvObject As Object) As Long
Private Declare PtrSafe Function FindWindowExA Lib "user32" ( _
ByVal hwndParent As LongPtr, ByVal hwndChildAfter As LongPtr, _
ByVal lpszClass As String, ByVal lpszWindow As String) As LongPtr
#Else
Private Declare Function AccessibleObjectFromWindow Lib "oleacc" ( _
ByVal hwnd As Long, ByVal dwId As Long, riid As Any, ppvObject As Object) As Long
Private Declare Function FindWindowExA Lib "user32" ( _
ByVal hwndParent As Long, ByVal hwndChildAfter As Long, _
ByVal lpszClass As String, ByVal lpszWindow As String) As Long
#End If
Sub Test()
Dim xl As Application
For Each xl In GetExcelInstances()
Debug.Print "Handle: " & xl.ActiveWorkbook.FullName
Next
End Sub
Public Function GetExcelInstances() As Collection
Dim guid&(0 To 3), acc As Object, hwnd, hwnd2, hwnd3
guid(0) = &H20400
guid(1) = &H0
guid(2) = &HC0
guid(3) = &H46000000
Set GetExcelInstances = New Collection
Do
hwnd = FindWindowExA(0, hwnd, "XLMAIN", vbNullString)
If hwnd = 0 Then Exit Do
hwnd2 = FindWindowExA(hwnd, 0, "XLDESK", vbNullString)
hwnd3 = FindWindowExA(hwnd2, 0, "EXCEL7", vbNullString)
If AccessibleObjectFromWindow(hwnd3, &HFFFFFFF0, guid(0), acc) = 0 Then
GetExcelInstances.Add acc.Application
End If
Loop
End Function
This would be best as a comment on Florent B.'s very useful function that returns a collection of the open Excel instances, but I don't have sufficient reputation to add comments. In my tests, the collection contained "repeats" of the same Excel instances i.e. GetExcelInstances().Count was larger than it should have been. A fix for that is the use of the AlreadyThere variable in the version below.
Private Function GetExcelInstances() As Collection
Dim guid&(0 To 3), acc As Object, hwnd, hwnd2, hwnd3
guid(0) = &H20400
guid(1) = &H0
guid(2) = &HC0
guid(3) = &H46000000
Dim AlreadyThere As Boolean
Dim xl As Application
Set GetExcelInstances = New Collection
Do
hwnd = FindWindowExA(0, hwnd, "XLMAIN", vbNullString)
If hwnd = 0 Then Exit Do
hwnd2 = FindWindowExA(hwnd, 0, "XLDESK", vbNullString)
hwnd3 = FindWindowExA(hwnd2, 0, "EXCEL7", vbNullString)
If AccessibleObjectFromWindow(hwnd3, &HFFFFFFF0, guid(0), acc) = 0 Then
AlreadyThere = False
For Each xl In GetExcelInstances
If xl Is acc.Application Then
AlreadyThere = True
Exit For
End If
Next
If Not AlreadyThere Then
GetExcelInstances.Add acc.Application
End If
End If
Loop
End Function
#PGS62/#Philip Swannell has the correct answer for returning a Collection; I can iterate all instances; and it is brilliant, as #M1chael comment.
Let's not confuse Application objects with Workbook objects... ...Of
course it would be possible to write a nested loop that loops over the
workbooks collection of each application object
This is the nested loop implemented and fully functional:
Sub Test2XL()
Dim xl As Excel.Application
Dim i As Integer
For Each xl In GetExcelInstances()
Debug.Print "Handle: " & xl.Application.hwnd
Debug.Print "# workbooks: " & xl.Application.Workbooks.Count
For i = 1 To xl.Application.Workbooks.Count
Debug.Print "Workbook: " & xl.Application.Workbooks(i).Name
Debug.Print "Workbook path: " & xl.Application.Workbooks(i).path
Next i
Next
Set xl = Nothing
End Sub
And, for Word instances, the nested loop:
Sub Test2Wd()
Dim wd As Word.Application
Dim i As Integer
For Each wd In GetWordInstancesCol()
Debug.Print "Version: " & wd.System.Version
Debug.Print "# Documents: " & wd.Application.Documents.Count
For i = 1 To wd.Application.Documents.Count
Debug.Print "Document: " & wd.Application.Documents(i).Name
Debug.Print "Document path: " & wd.Application.Documents(i).path
Next i
Next
Set wd = Nothing
End Sub
For Word you have to use what is explained in the end of this thread
I use the following to check if two instances are running, and display a message. It could be altered to close other instance... This may be of help... I need code to return a specific instance, and return for use similar to GetObject(,"Excel.Application")... I don't think it possible though
If checkIfExcelRunningMoreThanOneInstance() Then Exit Function
In module (some of the declarations are possible used for other code):
Const MaxNumberOfWindows = 10
Const HWND_TOPMOST = -1
Const SWP_NOSIZE = &H1
Const SWP_NOMOVE = &H2
Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Public Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Global ret As Integer
Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Declare Function GetKeyNameText Lib "user32" Alias "GetKeyNameTextA" (ByVal lParam As Long, ByVal lpBuffer As String, ByVal nSize As Long) As Long
Declare Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" (ByVal wCode As Long, ByVal wMapType As Long) As Long
Declare Function GetDesktopWindow Lib "user32" () As Long
Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Const VK_CAPITAL = &H14
Private Declare Function GetKeyState Lib "user32" _
(ByVal nVirtKey As Long) As Integer
Private Declare Function OpenProcess Lib "kernel32" ( _
ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" ( _
ByVal hObject As Long) As Long
Private Declare Function EnumProcesses Lib "PSAPI.DLL" ( _
lpidProcess As Long, ByVal cb As Long, cbNeeded As Long) As Long
Private Declare Function EnumProcessModules Lib "PSAPI.DLL" ( _
ByVal hProcess As Long, lphModule As Long, ByVal cb As Long, lpcbNeeded As Long) As Long
Private Declare Function GetModuleBaseName Lib "PSAPI.DLL" Alias "GetModuleBaseNameA" ( _
ByVal hProcess As Long, ByVal hModule As Long, ByVal lpFileName As String, ByVal nSize As Long) As Long
Private Const PROCESS_VM_READ = &H10
Private Const PROCESS_QUERY_INFORMATION = &H400
Global ExcelWindowName$ 'Used to switch back to later
Function checkIfExcelRunningMoreThanOneInstance()
'Check instance it is 1, else ask user to reboot excel, return TRUE to abort
ExcelWindowName = excel.Application.Caption 'Used to switch back to window later
If countProcessRunning("excel.exe") > 1 Then
Dim t$
t = "Two copies of 'Excel.exe' are running, which may stop in cell searching from working!" & vbCrLf & vbCrLf & "Please close all copies of Excel." & vbCrLf & _
" (1 Then press Alt+Ctrl+Del to go to task manager." & vbCrLf & _
" (2 Search the processes running to find 'Excel.exe'" & vbCrLf & _
" (3 Select it and press [End Task] button." & vbCrLf & _
" (4 Then reopen and use PostTrans"
MsgBox t, vbCritical, ApplicationName
End If
End Function
Private Function countProcessRunning(ByVal sProcess As String) As Long
Const MAX_PATH As Long = 260
Dim lProcesses() As Long, lModules() As Long, N As Long, lRet As Long, hProcess As Long
Dim sName As String
countProcessRunning = 0
sProcess = UCase$(sProcess)
ReDim lProcesses(1023) As Long
If EnumProcesses(lProcesses(0), 1024 * 4, lRet) Then
For N = 0 To (lRet \ 4) - 1
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, lProcesses(N))
If hProcess Then
ReDim lModules(1023)
If EnumProcessModules(hProcess, lModules(0), 1024 * 4, lRet) Then
sName = String$(MAX_PATH, vbNullChar)
GetModuleBaseName hProcess, lModules(0), sName, MAX_PATH
sName = Left$(sName, InStr(sName, vbNullChar) - 1)
If Len(sName) = Len(sProcess) Then
If sProcess = UCase$(sName) Then
countProcessRunning = countProcessRunning + 1
End If
End If
End If
End If
CloseHandle hProcess
Next N
End If
End Function
The I found:
Dim xlApp As Excel.Application
Set xlApp = GetObject("ExampleBook.xlsx").Application
Which gets the object if you know the name of the sheet currently active in Excel instance. I guess this could be got from the application title using the first bit of code. In my app I do know the filename.
This can accomplish what you want.
Determine if an instance of Excel is open:
Dim xlApp As Excel.Application
Set xlApp = GetObject(, "Excel.Application")
If an instance is running you can access it using the xlApp object. If an instance is not running you will get a run-time error (you might need/want an error handler). The GetObject function gets the first instance of Excel that had been loaded. You can do your job with it, and to get to others, you can close that one and then try GetObject again to get the next one, etc.
So you will be attaining your ok-but-second-preferred objective
(taken from http://excelribbon.tips.net/T009452_Finding_Other_Instances_of_Excel_in_a_Macro.html).
For attaining your preferred objective, I think that https://stackoverflow.com/a/3303016/2707864 shows you how.
Create an array of objects and store the newly created Excel.Application in the array. That way you can reference them as and when you need. Let's take a quick example:
In a module:
Dim ExcelApp(2) As Object
Sub Test()
Set ExcelApp(1) = CreateObject("Excel.Application")
ExcelApp(1).Visible = True
Set ExcelApp(2) = CreateObject("Excel.Application")
ExcelApp(2).Visible = True
End Sub
Sub AnotherTest()
ExcelApp(1).Quit
ExcelApp(2).Quit
End Sub
Run Test() macro and you should see two Excel Applications pop up. Then run AnotherTest() and the Excel Applications will quit. You can even set the array to Nothing after you are done.
You can get handle of running Excel applications using the script published on http://www.ozgrid.com/forum/showthread.php?t=182853. That should get you where you want to go.
You should use this code every time you need an Excel application object. This way, your code will only ever work with one application object or use a pre-existing one. The only way you could end up with more than one is if the user started more than one. This is both the code to open Excel and attach and reuse, like you want.
Public Function GetExcelApplication() As Object
On Error GoTo openExcel
Set GetExcelApplication = GetObject(, "Excel.Application")
Exit Function
openExcel:
If Err.Number = 429 Then
Set GetExcelApplication = CreateObject("Excel.Application")
Else
Debug.Print "Unhandled exception: " & Err.Number & " " & Err.Description
End If
End Function
If you wanted to close multiple instances you would need to call GetObject followed by .Close in a loop until it throws the error 429.
The details can be found in this Article

How to collect Excel.Application objects opened in a system?

I found the following code which is based on GetRunningObjectTable - WinAPI function.It collects all excel application objects into var array.
The problem that i am having in this code is that when i press run, it says : "CollectROT.dll" cannot be found.Also I could not find the library for ROT(Running Object Table).
Public Declare PtrSafe Function GetRunningExcelApps Lib "CollectROT.dll" (ByRef result As Variant) As Long
Public Const dllname As String = "CollectROT.dll"
Public glbApp As Application
Public Function GetExcelAppCollection() As Variant
Dim var As Variant
Dim appcalc As Long
Dim app As Application
ChDir (ThisWorkbook.Path)
appcalc = GetRunningExcelApps(var)
If appcalc > 0 Then
GetExcelAppCollection = var
Else
GetExcelAppCollection = Empty
End If
Exit Function
End Function
Please, copy the next code on top of a standard module (in the declarations area). It is designed to work in both (32 - 64 bit) versions:
Option Explicit
#If VBA7 Then
Private Declare PtrSafe Function FindWindowEx Lib "USER32" Alias _
"FindWindowExA" (ByVal hWnd1 As LongPtr, _
ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, _
ByVal lpsz2 As String) As LongPtr
Private Declare PtrSafe Function IIDFromString Lib "ole32" _
(ByVal lpsz As LongPtr, ByRef lpiid As GUID) As LongPtr
Private Declare PtrSafe Function AccessibleObjectFromWindow Lib "oleacc" _
(ByVal hWnd As LongPtr, ByVal dwId As LongPtr, ByRef riid As GUID, _
ByRef ppvObject As Object) As LongPtr
#Else
Private Declare Function FindWindowEx Lib "User32" Alias "FindWindowExA" _
(ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Long
Private Declare Function IIDFromString Lib "ole32" _
(ByVal lpsz As Long, ByRef lpiid As GUID) As Long
Private Declare Function AccessibleObjectFromWindow Lib "oleacc" _
(ByVal hWnd As Long, ByVal dwId As Long, ByRef riid As GUID, _
ByRef ppvObject As Object) As Long
#End If
Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type
Private Const S_OK As Long = &H0
Private Const IID_IDispatch As String = "{00020400-0000-0000-C000-000000000046}"
Private Const OBJID_NATIVEOM As Long = &HFFFFFFF0
Please, copy the next code in the same standard module. This should be the function doing what (I understood) you need:
Function GetExcelAppCollection() As Variant
Dim dict As Object, i As Long
#If VBA7 Then
Dim hWinXL As LongPtr
#Else
Dim hWinXL As Long
#End If
Dim xlApp As Object 'Excel.Application
Set dict = CreateObject("scripting.dictionary")
hWinXL = FindWindowEx(0&, 0&, "XLMAIN", vbNullString)
While hWinXL > 0
i = i + 1
If GetXLapp(hWinXL, xlApp) Then
If Not dict.Exists(xlApp.hWnd) Then
dict.Add xlApp.hWnd, xlApp
End If
End If
hWinXL = FindWindowEx(0, hWinXL, "XLMAIN", vbNullString)
Wend
GetExcelAppCollection = dict.Items
End Function
Copy the next function (called by the above one) in the same module:
#If VBA7 Then
Function GetXLapp(hWinXL As LongPtr, xlApp As Object) As Boolean
Dim hWinDesk As LongPtr, hWin7 As LongPtr
#Else
Function GetXLapp(hWinXL As Long, xlApp As Object) As Boolean
Dim hWinDesk As Long, hWin7 As Long
#End If
Dim obj As Object
Dim iid As GUID
Call IIDFromString(StrPtr(IID_IDispatch), iid)
hWinDesk = FindWindowEx(hWinXL, 0&, "XLDESK", vbNullString)
hWin7 = FindWindowEx(hWinDesk, 0&, "EXCEL7", vbNullString)
If AccessibleObjectFromWindow(hWin7, OBJID_NATIVEOM, iid, obj) = S_OK Then
Set xlApp = obj.Application
GetXLapp = True
End If
End Function
It can be tested using the next test Sub:
Sub testGetExAppColl()
Dim arr As Variant
arr = GetExcelAppCollection
Debug.Print arr(0).Workbooks(1).Name, arr(UBound(arr)).Workbooks.count
End Sub
Please, test it and send some feedback. The code is not so complicated as it can be considered at the first glance... I can simplify it for being used only in 64 bit environment, but I do not think that this can really be an issue.
If something not clear enough, do not hesitate to ask, please.
Edited:
The next function returns all open workbooks (as objects) in a collection. It is similar to the one returning Excel application objects, but it dig a little deeper, extracting all open documents:
Function GetAllWorkbooks() As Collection
Dim i As Long
#If VBA7 Then
Dim hWinXL As LongPtr
#Else
Dim hWinXL As Long
#End If
Dim xlApp As Object 'Excel.Application
Dim wb As Object ' Excel.Workbook
Dim dict, k, Col As New Collection
Set dict = CreateObject("scripting.dictionary")
hWinXL = FindWindowEx(0&, 0&, "XLMAIN", vbNullString)
While hWinXL > 0
i = i + 1
If GetXLapp(hWinXL, xlApp) Then
If Not dict.Exists(xlApp.hWnd) Then
dict.Add xlApp.hWnd, xlApp
For Each wb In xlApp.Workbooks
Col.Add wb
Next
End If
End If
hWinXL = FindWindowEx(0, hWinXL, "XLMAIN", vbNullString)
Wend
Set GetAllWorkbooks = Col
End Function
In order to test it, you can use the next Sub:
Sub EnumAllOpenWorkbooks()
Dim Col As Collection, wb As Workbook
Set Col = GetAllWorkbooks()
For Each wb In Col
'you can find the one you need
Debug.Print wb.Name & ":" & _
IIf(wb.Application.hWnd = Application.hWnd, _
"In this instance", "In another instance")
Next wb
End Sub
.Net has his own "api-dll" to manage proccess.
Try that and tell me if is useful for you.
For Each p As Process In Process.GetProcesses
If String.compare(p.ProcessName, "excel",true) = 0 Then
'Do stuff
msgbox("hi im a excel process")
End If
Next

Close specific Excel file opened by user from Access-VBA

I see version of how to do this with
Dim ran as Excel.Applcation
but the version of Access I am using doesn't have Excel.Application as an option.
I have written the following code that runs, but does not close the file
Dim Path1 as String
Dim objXL As Object
Dim xlWB As Object
Path1 = "C:/....."
Set objXL = CreateObject("Excel.Application")
Set xlWB = objXL.Workbooks.Open(Path1)
xlWB.Close False
Set xlWB = Nothing
objXL.Quit
Set objXL = Nothing
You can use the following code to close all Excel files (already posted here):
Public Sub CloseAllExcel()
Dim obj As Object
On Error GoTo ExitSub
Dim i As Integer
'There shouldn't be more than 10000 running Excel applications
'Can use While True too, but small risk of infinite loop
For i = 0 To 10000
Set obj = GetObject(, "Excel.Application")
obj.Quit
Next i
ExitSub:
End Sub
But if we're going to close one specific one, we need some Win32 magic that I can't do, but hey, if you can't do something, you can find it on StackOverflow.
Most code by Florent B found here
First, declare our Win32 functions
#If VBA7 Then
Private Declare PtrSafe Function AccessibleObjectFromWindow Lib "oleacc" ( _
ByVal hwnd As LongPtr, ByVal dwId As Long, riid As Any, ppvObject As Object) As Long
Private Declare PtrSafe Function FindWindowExA Lib "user32" ( _
ByVal hwndParent As LongPtr, ByVal hwndChildAfter As LongPtr, _
ByVal lpszClass As String, ByVal lpszWindow As String) As LongPtr
#Else
Private Declare Function AccessibleObjectFromWindow Lib "oleacc" ( _
ByVal hwnd As Long, ByVal dwId As Long, riid As Any, ppvObject As Object) As Long
Private Declare Function FindWindowExA Lib "user32" ( _
ByVal hwndParent As Long, ByVal hwndChildAfter As Long, _
ByVal lpszClass As String, ByVal lpszWindow As String) As Long
#End If
Then use them to get all running Excel application objects
Public Function GetExcelInstances() As Collection
Dim guid&(0 To 3), acc As Object, hwnd, hwnd2, hwnd3
guid(0) = &H20400
guid(1) = &H0
guid(2) = &HC0
guid(3) = &H46000000
Set GetExcelInstances = New Collection
Do
hwnd = FindWindowExA(0, hwnd, "XLMAIN", vbNullString)
If hwnd = 0 Then Exit Do
hwnd2 = FindWindowExA(hwnd, 0, "XLDESK", vbNullString)
hwnd3 = FindWindowExA(hwnd2, 0, "EXCEL7", vbNullString)
If AccessibleObjectFromWindow(hwnd3, &HFFFFFFF0, guid(0), acc) = 0 Then
GetExcelInstances.Add acc.Application
End If
Loop
End Function
And then use that collection so we can check which one has the workbook open, and close it
Public Sub closeWorkbook(workbookPath As String)
Dim excelInstances As Collection
Set excelInstances = GetExcelInstances
Dim excelApp As Object
Dim excelWorkbook As Object
For Each excelApp In excelInstances
For Each excelWorkbook In excelApp.Workbooks
If excelWorkbook.FullName = workbookPath Then
excelWorkbook.Close False
End If
Next excelWorkbook
If excelApp.Workbooks.Count = 0 Then
excelApp.Quit
End If
Next excelApp
End Sub
And then, implement that close function
Dim Path1 as String
Path1 = "C:/....."
closeWorkbook Path1

Having multiple Excel instances launched, how can I get the Application Object for all of them?

I want to use something similar to
GetObject(,"Excel.Application") to get back the application I created.
I call CreateObject("Excel.Application") to create Excel instances. Later if the VBA project resets, due to debugging and coding, the Application object variables are lost but the Excel instances are running in the background. Kind of a memory leak situation.
I want to re-attach to either re-use (preferred way) or close them.
To list the running instances of Excel:
#If VBA7 Then
Private Declare PtrSafe Function AccessibleObjectFromWindow Lib "oleacc" ( _
ByVal hwnd As LongPtr, ByVal dwId As Long, riid As Any, ppvObject As Object) As Long
Private Declare PtrSafe Function FindWindowExA Lib "user32" ( _
ByVal hwndParent As LongPtr, ByVal hwndChildAfter As LongPtr, _
ByVal lpszClass As String, ByVal lpszWindow As String) As LongPtr
#Else
Private Declare Function AccessibleObjectFromWindow Lib "oleacc" ( _
ByVal hwnd As Long, ByVal dwId As Long, riid As Any, ppvObject As Object) As Long
Private Declare Function FindWindowExA Lib "user32" ( _
ByVal hwndParent As Long, ByVal hwndChildAfter As Long, _
ByVal lpszClass As String, ByVal lpszWindow As String) As Long
#End If
Sub Test()
Dim xl As Application
For Each xl In GetExcelInstances()
Debug.Print "Handle: " & xl.ActiveWorkbook.FullName
Next
End Sub
Public Function GetExcelInstances() As Collection
Dim guid&(0 To 3), acc As Object, hwnd, hwnd2, hwnd3
guid(0) = &H20400
guid(1) = &H0
guid(2) = &HC0
guid(3) = &H46000000
Set GetExcelInstances = New Collection
Do
hwnd = FindWindowExA(0, hwnd, "XLMAIN", vbNullString)
If hwnd = 0 Then Exit Do
hwnd2 = FindWindowExA(hwnd, 0, "XLDESK", vbNullString)
hwnd3 = FindWindowExA(hwnd2, 0, "EXCEL7", vbNullString)
If AccessibleObjectFromWindow(hwnd3, &HFFFFFFF0, guid(0), acc) = 0 Then
GetExcelInstances.Add acc.Application
End If
Loop
End Function
This would be best as a comment on Florent B.'s very useful function that returns a collection of the open Excel instances, but I don't have sufficient reputation to add comments. In my tests, the collection contained "repeats" of the same Excel instances i.e. GetExcelInstances().Count was larger than it should have been. A fix for that is the use of the AlreadyThere variable in the version below.
Private Function GetExcelInstances() As Collection
Dim guid&(0 To 3), acc As Object, hwnd, hwnd2, hwnd3
guid(0) = &H20400
guid(1) = &H0
guid(2) = &HC0
guid(3) = &H46000000
Dim AlreadyThere As Boolean
Dim xl As Application
Set GetExcelInstances = New Collection
Do
hwnd = FindWindowExA(0, hwnd, "XLMAIN", vbNullString)
If hwnd = 0 Then Exit Do
hwnd2 = FindWindowExA(hwnd, 0, "XLDESK", vbNullString)
hwnd3 = FindWindowExA(hwnd2, 0, "EXCEL7", vbNullString)
If AccessibleObjectFromWindow(hwnd3, &HFFFFFFF0, guid(0), acc) = 0 Then
AlreadyThere = False
For Each xl In GetExcelInstances
If xl Is acc.Application Then
AlreadyThere = True
Exit For
End If
Next
If Not AlreadyThere Then
GetExcelInstances.Add acc.Application
End If
End If
Loop
End Function
#PGS62/#Philip Swannell has the correct answer for returning a Collection; I can iterate all instances; and it is brilliant, as #M1chael comment.
Let's not confuse Application objects with Workbook objects... ...Of
course it would be possible to write a nested loop that loops over the
workbooks collection of each application object
This is the nested loop implemented and fully functional:
Sub Test2XL()
Dim xl As Excel.Application
Dim i As Integer
For Each xl In GetExcelInstances()
Debug.Print "Handle: " & xl.Application.hwnd
Debug.Print "# workbooks: " & xl.Application.Workbooks.Count
For i = 1 To xl.Application.Workbooks.Count
Debug.Print "Workbook: " & xl.Application.Workbooks(i).Name
Debug.Print "Workbook path: " & xl.Application.Workbooks(i).path
Next i
Next
Set xl = Nothing
End Sub
And, for Word instances, the nested loop:
Sub Test2Wd()
Dim wd As Word.Application
Dim i As Integer
For Each wd In GetWordInstancesCol()
Debug.Print "Version: " & wd.System.Version
Debug.Print "# Documents: " & wd.Application.Documents.Count
For i = 1 To wd.Application.Documents.Count
Debug.Print "Document: " & wd.Application.Documents(i).Name
Debug.Print "Document path: " & wd.Application.Documents(i).path
Next i
Next
Set wd = Nothing
End Sub
For Word you have to use what is explained in the end of this thread
I use the following to check if two instances are running, and display a message. It could be altered to close other instance... This may be of help... I need code to return a specific instance, and return for use similar to GetObject(,"Excel.Application")... I don't think it possible though
If checkIfExcelRunningMoreThanOneInstance() Then Exit Function
In module (some of the declarations are possible used for other code):
Const MaxNumberOfWindows = 10
Const HWND_TOPMOST = -1
Const SWP_NOSIZE = &H1
Const SWP_NOMOVE = &H2
Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Public Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Global ret As Integer
Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Declare Function GetKeyNameText Lib "user32" Alias "GetKeyNameTextA" (ByVal lParam As Long, ByVal lpBuffer As String, ByVal nSize As Long) As Long
Declare Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" (ByVal wCode As Long, ByVal wMapType As Long) As Long
Declare Function GetDesktopWindow Lib "user32" () As Long
Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Const VK_CAPITAL = &H14
Private Declare Function GetKeyState Lib "user32" _
(ByVal nVirtKey As Long) As Integer
Private Declare Function OpenProcess Lib "kernel32" ( _
ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" ( _
ByVal hObject As Long) As Long
Private Declare Function EnumProcesses Lib "PSAPI.DLL" ( _
lpidProcess As Long, ByVal cb As Long, cbNeeded As Long) As Long
Private Declare Function EnumProcessModules Lib "PSAPI.DLL" ( _
ByVal hProcess As Long, lphModule As Long, ByVal cb As Long, lpcbNeeded As Long) As Long
Private Declare Function GetModuleBaseName Lib "PSAPI.DLL" Alias "GetModuleBaseNameA" ( _
ByVal hProcess As Long, ByVal hModule As Long, ByVal lpFileName As String, ByVal nSize As Long) As Long
Private Const PROCESS_VM_READ = &H10
Private Const PROCESS_QUERY_INFORMATION = &H400
Global ExcelWindowName$ 'Used to switch back to later
Function checkIfExcelRunningMoreThanOneInstance()
'Check instance it is 1, else ask user to reboot excel, return TRUE to abort
ExcelWindowName = excel.Application.Caption 'Used to switch back to window later
If countProcessRunning("excel.exe") > 1 Then
Dim t$
t = "Two copies of 'Excel.exe' are running, which may stop in cell searching from working!" & vbCrLf & vbCrLf & "Please close all copies of Excel." & vbCrLf & _
" (1 Then press Alt+Ctrl+Del to go to task manager." & vbCrLf & _
" (2 Search the processes running to find 'Excel.exe'" & vbCrLf & _
" (3 Select it and press [End Task] button." & vbCrLf & _
" (4 Then reopen and use PostTrans"
MsgBox t, vbCritical, ApplicationName
End If
End Function
Private Function countProcessRunning(ByVal sProcess As String) As Long
Const MAX_PATH As Long = 260
Dim lProcesses() As Long, lModules() As Long, N As Long, lRet As Long, hProcess As Long
Dim sName As String
countProcessRunning = 0
sProcess = UCase$(sProcess)
ReDim lProcesses(1023) As Long
If EnumProcesses(lProcesses(0), 1024 * 4, lRet) Then
For N = 0 To (lRet \ 4) - 1
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, lProcesses(N))
If hProcess Then
ReDim lModules(1023)
If EnumProcessModules(hProcess, lModules(0), 1024 * 4, lRet) Then
sName = String$(MAX_PATH, vbNullChar)
GetModuleBaseName hProcess, lModules(0), sName, MAX_PATH
sName = Left$(sName, InStr(sName, vbNullChar) - 1)
If Len(sName) = Len(sProcess) Then
If sProcess = UCase$(sName) Then
countProcessRunning = countProcessRunning + 1
End If
End If
End If
End If
CloseHandle hProcess
Next N
End If
End Function
The I found:
Dim xlApp As Excel.Application
Set xlApp = GetObject("ExampleBook.xlsx").Application
Which gets the object if you know the name of the sheet currently active in Excel instance. I guess this could be got from the application title using the first bit of code. In my app I do know the filename.
This can accomplish what you want.
Determine if an instance of Excel is open:
Dim xlApp As Excel.Application
Set xlApp = GetObject(, "Excel.Application")
If an instance is running you can access it using the xlApp object. If an instance is not running you will get a run-time error (you might need/want an error handler). The GetObject function gets the first instance of Excel that had been loaded. You can do your job with it, and to get to others, you can close that one and then try GetObject again to get the next one, etc.
So you will be attaining your ok-but-second-preferred objective
(taken from http://excelribbon.tips.net/T009452_Finding_Other_Instances_of_Excel_in_a_Macro.html).
For attaining your preferred objective, I think that https://stackoverflow.com/a/3303016/2707864 shows you how.
Create an array of objects and store the newly created Excel.Application in the array. That way you can reference them as and when you need. Let's take a quick example:
In a module:
Dim ExcelApp(2) As Object
Sub Test()
Set ExcelApp(1) = CreateObject("Excel.Application")
ExcelApp(1).Visible = True
Set ExcelApp(2) = CreateObject("Excel.Application")
ExcelApp(2).Visible = True
End Sub
Sub AnotherTest()
ExcelApp(1).Quit
ExcelApp(2).Quit
End Sub
Run Test() macro and you should see two Excel Applications pop up. Then run AnotherTest() and the Excel Applications will quit. You can even set the array to Nothing after you are done.
You can get handle of running Excel applications using the script published on http://www.ozgrid.com/forum/showthread.php?t=182853. That should get you where you want to go.
You should use this code every time you need an Excel application object. This way, your code will only ever work with one application object or use a pre-existing one. The only way you could end up with more than one is if the user started more than one. This is both the code to open Excel and attach and reuse, like you want.
Public Function GetExcelApplication() As Object
On Error GoTo openExcel
Set GetExcelApplication = GetObject(, "Excel.Application")
Exit Function
openExcel:
If Err.Number = 429 Then
Set GetExcelApplication = CreateObject("Excel.Application")
Else
Debug.Print "Unhandled exception: " & Err.Number & " " & Err.Description
End If
End Function
If you wanted to close multiple instances you would need to call GetObject followed by .Close in a loop until it throws the error 429.
The details can be found in this Article

Resources