我刚从办公室32位移到办公室64位。我有很多Outlook宏，Outlook帮助指出所有需要更改的VBA代码，并且我已经能够解决大部分问题。我正在努力解决的问题是我在上一篇stackexchange帖子中帮助写的代码：
Open attachment in excel window and copy to open workbook
代码应该在我的电子表格中找到一个excel窗口，这样我就可以在代码的其余部分搞乱它了。回顾一下，下面的内容是32位：
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'设置为打开它的应用程序。
我评论了这条断线：
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
答案 0 :(得分：0)
您已使用32位数据类型的简写表示法声明AccessibleObjectFromWindow()，请尝试更改为：
Private Declare PtrSafe Function AccessibleObjectFromWindow Lib "oleacc" _
(ByVal hwnd As LongPtr, ByVal dwId As LongPtr, riid As GUID, xlWB As Object) As LongPtr
答案 1 :(得分：0)
终于在这里找到了答案： https://stackoverflow.com/a/28504836/317958
所以我犯了两个错误，首先我对变化过于热心：
<a class="btn btn-info" ng-click="imageActive= true;">Test</a>
应该保留：
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