在"AccessibleObjectFromWindow"上,将VBA从32位办公室迁移到64位办公室失败.在oleacc [英] Migrating VBA from 32 to 64 bit office fails on "AccessibleObjectFromWindow" in oleacc
问题描述
我刚刚从32位办公室迁移到64位办公室.我有很多Outlook宏,Outlook会帮助您指出所有需要更改的VBA代码,而且我已经能够修复其中的大多数问题.我苦苦挣扎的是我在我的最后一个stackexchange帖子中写过的代码的帮助:
I've just moved from office 32 bit to office 64 bit. I have a lot of Outlook macros and Outlook helpfully points out all your VBA code that needs changing, and I've been able to fix most of it. The bit I'm struggling with is the code that I had help writing on one of my last stackexchange posts:
该代码应该找到一个包含电子表格的excel窗口,因此我可以在其余的代码中弄乱它.回顾一下,以下内容以32位工作:
The code is supposed to find an excel window with my spreadsheet in it so I can mess about with it in the remainder of the code. Just to recap, the below works in 32 bit:
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 GetDesktopWindow Lib "user32" () As Long
Private Declare Function AccessibleObjectFromWindow& Lib "oleacc" _
(ByVal hwnd&, ByVal dwId&, riid As GUID, xlWB As Object)
Private Const OBJID_NATIVEOM = &HFFFFFFF0
Private Type GUID
lData1 As Long
iData2 As Integer
iData3 As Integer
aBData4(0 To 7) As Byte
End Type
Sub Sample()
Dim Ret
Dim oXLApp As Object, wb As Object
Dim sPath As String, sFileName As String, SFile As String, filewithoutExt As String
Dim IDispatch As GUID
sPath = "C:\Users\Chris\Desktop\"
sFileName = "Data.xlsx": filewithoutExt = "Data"
SFile = sPath & sFileName
Ret = IsWorkBookOpen(SFile)
'~~> If file is open
If Ret = True Then
Dim dsktpHwnd As Long, hwnd As Long, mWnd As Long, cWnd As Long
SetIDispatch IDispatch
dsktpHwnd = GetDesktopWindow
hwnd = FindWindowEx(dsktpHwnd, 0&, "XLMAIN", vbNullString)
mWnd = FindWindowEx(hwnd, 0&, "XLDESK", vbNullString)
While mWnd <> 0 And cWnd = 0
cWnd = FindWindowEx(mWnd, 0&, "EXCEL7", filewithoutExt)
hwnd = FindWindowEx(dsktpHwnd, hwnd, "XLMAIN", vbNullString)
mWnd = FindWindowEx(hwnd, 0&, "XLDESK", vbNullString)
Wend
'~~> We got the handle of the Excel instance which has the file
If cWnd > 0 Then
'~~> Bind with the Instance
Call AccessibleObjectFromWindow(cWnd, OBJID_NATIVEOM, IDispatch, wb)
'~~> Work with the file
With wb.Application.Workbooks(sFileName)
'
'~~> Rest of the code
'
End With
End If
'~~> If file is not open
Else
On Error Resume Next
Set oXLApp = GetObject(, "Excel.Application")
'~~> If not found then create new instance
If Err.Number <> 0 Then
Set oXLApp = CreateObject("Excel.Application")
End If
Err.Clear
On Error GoTo 0
Set wb = oXLApp.Workbooks.Open(SFile)
'
'~~> Rest of the code
'
End If
End Sub
Private Sub SetIDispatch(ByRef ID As GUID)
With ID
.lData1 = &H20400
.iData2 = &H0
.iData3 = &H0
.aBData4(0) = &HC0
.aBData4(1) = &H0
.aBData4(2) = &H0
.aBData4(3) = &H0
.aBData4(4) = &H0
.aBData4(5) = &H0
.aBData4(6) = &H0
.aBData4(7) = &H46
End With
End Sub
'~~> Function to check if file is open
Function IsWorkBookOpen(FileName As String)
Dim ff As Long, ErrNo As Long
On Error Resume Next
ff = FreeFile()
Open FileName For Input Lock Read As #ff
Close ff
ErrNo = Err
On Error GoTo 0
Select Case ErrNo
Case 0: IsWorkBookOpen = False
Case 70: IsWorkBookOpen = True
Case Else: Error ErrNo
End Select
End Function
下面似乎只有一行失败,仅在您要查找的excel文件打开时才调用,而在32位版本中,它将"wb"设置为打开它的应用程序.
There seems to be one line failing in the below, which is only invoked when the excel file you're looking is open, and in the 32 bit version it sets 'wb' to the application that's got it open.
我评论了虚线:
Option Explicit
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
Public Declare PtrSafe Function GetDesktopWindow Lib "user32" () As LongPtr
Private Declare Function AccessibleObjectFromWindow& Lib "oleacc" _
(ByVal hwnd&, ByVal dwId&, riid As GUID, xlWB As Object)
Private Const OBJID_NATIVEOM = &HFFFFFFF0
Private Type GUID
lData1 As LongPtr
iData2 As Integer
iData3 As Integer
aBData4(0 To 7) As Byte
End Type
Sub Sample()
Dim Ret
Dim oXLApp As Object, wb As Object
Dim sPath As String, sFileName As String, SFile As String, filewithoutExt As String
Dim IDispatch As GUID
sPath = "C:\Users\Chris\Desktop\"
sFileName = "Data.xlsx": filewithoutExt = "Data"
SFile = sPath & sFileName
Ret = IsWorkBookOpen(SFile)
'~~> If file is open
If Ret = True Then
Dim dsktpHwnd As LongPtr, hwnd As LongPtr, mWnd As LongPtr, cWnd As LongPtr
SetIDispatch IDispatch
dsktpHwnd = GetDesktopWindow
hwnd = FindWindowEx(dsktpHwnd, 0&, "XLMAIN", vbNullString)
mWnd = FindWindowEx(hwnd, 0&, "XLDESK", vbNullString)
While mWnd <> 0 And cWnd = 0
cWnd = FindWindowEx(mWnd, 0&, "EXCEL7", filewithoutExt)
hwnd = FindWindowEx(dsktpHwnd, hwnd, "XLMAIN", vbNullString)
mWnd = FindWindowEx(hwnd, 0&, "XLDESK", vbNullString)
Wend
'~~> We got the handle of the Excel instance which has the file
If cWnd > 0 Then
'~~> Bind with the Instance
'!!!!!!!!!!this next line does nothing!!!!!!!
Call AccessibleObjectFromWindow(cWnd, OBJID_NATIVEOM, IDispatch, wb)
'~~> Work with the file
With wb.Application.Workbooks(sFileName)
'
'~~> Rest of the code
'
End With
End If
'~~> If file is not open
Else
On Error Resume Next
Set oXLApp = GetObject(, "Excel.Application")
'~~> If not found then create new instance
If Err.Number <> 0 Then
Set oXLApp = CreateObject("Excel.Application")
End If
Err.Clear
On Error GoTo 0
Set wb = oXLApp.Workbooks.Open(SFile)
'
'~~> Rest of the code
'
End If
End Sub
Private Sub SetIDispatch(ByRef ID As GUID)
With ID
.lData1 = &H20400
.iData2 = &H0
.iData3 = &H0
.aBData4(0) = &HC0
.aBData4(1) = &H0
.aBData4(2) = &H0
.aBData4(3) = &H0
.aBData4(4) = &H0
.aBData4(5) = &H0
.aBData4(6) = &H0
.aBData4(7) = &H46
End With
End Sub
'~~> Function to check if file is open
Function IsWorkBookOpen(FileName As String)
Dim ff As Long, ErrNo As Long
On Error Resume Next
ff = FreeFile()
Open FileName For Input Lock Read As #ff
Close ff
ErrNo = Err
On Error GoTo 0
Select Case ErrNo
Case 0: IsWorkBookOpen = False
Case 70: IsWorkBookOpen = True
Case Else: Error ErrNo
End Select
End Function
推荐答案
最后在这里找到了答案: https://stackoverflow.com/a/28504836/317958
Finally found an answer here: https://stackoverflow.com/a/28504836/317958
所以我犯了两个错误,首先是我对变化过于热情:
So I made two mistakes, first I was over-enthusiastic with changes:
Private Type GUID
lData1 As LongPtr
iData2 As Integer
iData3 As Integer
aBData4(0 To 7) As Byte
End Type
应保留:
Private Type GUID
lData1 As Long
iData2 As Integer
iData3 As Integer
aBData4(0 To 7) As Byte
End Type
声明应为:
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
这篇关于在"AccessibleObjectFromWindow"上,将VBA从32位办公室迁移到64位办公室失败.在oleacc的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!