[英]How to refer to an Open Excel Workbook from PowerPoint VBA ? (without GetObject)
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).我正在 PowerPoint VBA 中编写一个程序,该程序需要将数据发送到 Excel 工作簿(wbPool,文件路径是 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. GetObject(wbPoolPath) 不返回任何内容。 my guess is that my company's antivirus software blocks the use of GetObject.
我的猜测是我公司的防病毒软件阻止了 GetObject 的使用。
So i tried 2 different means to replace GetObject to Set wbPool:所以我尝试了 2 种不同的方法来替换 GetObject 到 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"两者都返回 wbPool = Nothing,而 Excel.Workbooks 返回“脱离上下文”
What i am missing?我错过了什么?
EDIT: the problem might be unsolvable because of Cylance Protect which is the antivirus software my company uses编辑:问题可能无法解决,因为 Cylance Protect 是我公司使用的防病毒软件
I guess you work on a Windows PC then the following code will get the Excel instance for a given workbook name我猜您在 Windows PC 上工作,然后以下代码将获取给定工作簿名称的 Excel 实例
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 .上面的代码是基于这个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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.