How to refer to an Open Excel Workbook from PowerPoint VBA ? (without GetObject)-CodePudding

i am writing a program in PowerPoint VBA that needs to send data to an Excel Workbook (wbPool, for which is file path is wbPoolPath). When the workbook is not open my code is working correctly but I am having trouble referencing to that workbook when it is already open.

Here's my code :

Dim wbPool As Excel.Workbook
If isOpen(wbPoolPath) Then ' isOpen returns True if wbPool is already open, returns False if not
    Set wbPool = GetObject(wbPoolPath) ' returns wbPool = Nothing 
Else
    Set wbPool = Excel.Workbooks.Open(wbPoolPath)
End If
If wbPool Is Nothing Then GoTo ErrPoolOpen

GetObject(wbPoolPath) returns Nothing. my guess is that my company's antivirus software blocks the use of GetObject.

So i tried 2 different means to replace GetObject to Set wbPool :

'Split is used to get the workbook name from its fullname
Set wbPool = Workbooks(Split(wbPoolPath, "\")(UBound(Split(wbPoolPath, "\"))))

'Loops through all workbooks until it matches with wbPool
Dim wb As Excel.Workbook
For Each wb In Excel.Workbooks
   If wb.FullName = wbPoolPath Then
       Set wbPool = wb
       Exit For
   End If
Next wb

Both returns wbPool = Nothing, while Excel.Workbooks returns "Out of context"

What i am missing ?

EDIT : the problem might be unsolvable because of Cylance Protect which is the antivirus software my company uses

CodePudding user response：

I guess you work on a Windows PC then the following code will get the Excel instance for a given workbook name

Option Explicit

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
         
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

Function getXLApp(hWinXL As Long, xlApp As Excel.Application) 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

Function getWorkbook(wkbName As String) As Workbook
    
    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
                    Set getWorkbook = wb
                End If
            Next
        End If
        hWinXL = FindWindowEx(0, hWinXL, "XLMAIN", vbNullString)
    Loop
    
End Function

Above code is based on this SO post. You can test it with

Sub TestIt()

    Dim wkbName As String
    wkbName = "WorkbookName.xlsx"

    Dim wkb As Workbook
    Set wkb = getWorkbook(wkbName)
    
    If wkb Is Nothing Then
        Debug.Print "Not open"
    Else
        Debug.Print "Open"
        wkb.Close False
    End If

End Sub