Migrating VBA from 32 to 64 bit office fails on “A

Question

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:

Open attachment in excel window and copy to open workbook

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

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.

I've commented the broken line:

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

Answer 1

You've declared AccessibleObjectFromWindow() using shorthand notation which uses 32bit data types, try changing to:

Private Declare PtrSafe Function AccessibleObjectFromWindow Lib "oleacc" _
(ByVal hwnd As LongPtr, ByVal dwId As LongPtr, riid As GUID, xlWB As Object) As LongPtr

Answer 2

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

Should remain:

Private Type GUID
    lData1 As Long
    iData2 As Integer
    iData3 As Integer
    aBData4(0 To 7) As Byte
End Type

And the declaration should be:

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