Retrieve data from unsaved Excel workbook: GetObject("Book1")

[themick]

The office has a case management system that will export the filtered data to Excel. By default, it will create a workbook called 'Book1' and place all data filtered to 'Sheet1".
Up until recently, I have used the code below on a Windows 7 machine using Excel 2010. We are starting the upgrade process to prepare for end of life Windows 7 so am testing code in the Windows 10 environment.

The VBA macro that did work will error now in Windows 10. I tried running same code in Windows 10 using Excel 2016 but same problem. Here is the code:

SUB IMPORT_DATA ()

    Dim oApp As Application
    Dim oWb As Workbook
    
    
    Set oWb = GetObject("Book1")
    Set oApp = oWb.Parent
    

    Windows("Audit_Billing.xlsm").Activate
    
'
    With Workbooks("AUDIT_BILLING.xlsm").Worksheets("DATA") '<--| sheet name
    Intersect(.Range(.Rows(1), .UsedRange.Rows(.UsedRange.Rows.Count)), .Range("A:I")).ClearContents 
    End With
'RESTOF CODE....
END SUB

The macro, excecuted from workbook AUDIT_BILLING.xlsm, pulls the data from the unsaved book and copies it to a sheet called 'DATA' in the AUDIT_BILLNG workbook.
This now errors out at the line:
Set oWb = GetObject("Book1")

With this error message:

[TABLE="width: 158"]
<tbody>[TR]
[TD="width: 211, bgcolor: transparent"]Run-time error '-2147221020(800401e4)':
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]Automation error
[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]Invalid Syntax
[/TD]
[/TR]
</tbody>[/TABLE]
------------
Would appreciate any help/insight on this as we import a lot of data like this from the case management system, thanks
M

 

[Jaafar Tribak]

Do not call GetRemoteObject from the client workbook nor execute any code from it.

Just let book1 to be opened in the other instance and wait for the MsgBox to show up.

I only need to know what the value returned by the messagebox in the book1 instance is .

 

[themick]

I copied/pasted the new code which replaced the existing add-in code. Then created a new Book1. It's been about 15 min-with no response from the spreadsheet, is this expected? Thanks
M

 

[Jaafar Tribak]

I copied/pasted the new code which replaced the existing add-in code. Then created a new Book1. It's been about 15 min-with no response from the spreadsheet, is this expected? Thanks
M

Not really. ... Don't know why.

There is only one more thing that we can try .. Instead of importing the data from book1 we can try reversing the process and export the data from book1 to Audit_Billing.xlsm via the add-in.

Sub [COLOR=#0000ff][B]EXPORT_DATA[/B][/COLOR]()
     
    Dim oWb As Workbook
        
    [B][COLOR=#0000ff]Set oWb = GetObject("Audit_Billing.xlsm")[/COLOR][/B]
   '
    With [B][COLOR=#0000ff]oWb[/COLOR][/B].Worksheets("DATA") '<--| sheet name
    Intersect(.Range(.Rows(1), .UsedRange.Rows(.UsedRange.Rows.Count)), .Range("A:I")).ClearContents
    End With
    
[B][COLOR=#008000]'RESTOF CODE....[/COLOR][/B]
End Sub

The above amended code should be added to the Add-in but I need to see the rest of your code that shows the data that needs to be exported from book1 to Audit_Billing.xlsm

If this still doesn't work, I am afraid I won't be able to help anymore.

 

[themick]

I understand and thank you. I will try that in a bit after I clear my desk off some.
I also thought as a workaround, I could just save the the data to its default name "Book1" to my C:\ drive and then just point the macro to the designated path.
I have emailed the software company that wrotethis program and see if they could provide any insight as to why their export is recognized in the Win7 OS environment but fails in the Win10.
I'll update you after a bit, thank you.
M

 

[themick]

PS - i closed everything up and then reopened just a blank Excel spreadsheet. Your last add-in that results in no response now pops up a message box with just a zero '0'. It only occurs when I open Excel to a blank spreadsheet 'Book1' but not when a new set of data is generated by the case management software as 'Book1", fyi - thanks

M

 

[Jaafar Tribak]

I understand and thank you. I will try that in a bit after I clear my desk off some.

Good and please do let us know the outcome.

Regards.

 

[RoryA]

Just as an FYI, if the software is automating Excel using Createobject, none of the startup workbooks, including add-ins, would actually be loaded for that instance, which might explain why that approach wasn’t working.

Also, on a general note, please don’t quote each other’s posts unnecessarily. It makes the thread harder to follow and increases the database size. Thanks.

 

[Jaafar Tribak]

Just as an FYI, if the software is automating Excel using Createobject, none of the startup workbooks, including add-ins, would actually be loaded for that instance, which might explain why that approach wasn’t working.

Good point Rory - I forgot about that possibility.. That's probably why the addin approach didn't work.
However, automating excel via createobject shouldn't prevent the automated instance from registering itself in the ROT.

Also, on a general note, please don’t quote each other’s posts unnecessarily. It makes the thread harder to follow and increases the database size. Thanks.

Point taken.

 

[Jaafar Tribak]

@themick,

I am not sure if this will work but I think it is worthwhile giving it a try.

Forget about the addin approach ... Just have book1 opened first in its seperate instance as usual and then run the following routine from the Audit_Billing.xlsm workbook vbaProject.

Option Explicit

Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type

[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL]  VBA7 Then
    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
    Private Declare PtrSafe Function ObjectFromLresult Lib "oleacc" (ByVal lResult As LongPtr, riid As Any, ByVal wParam As LongPtr, ppvObject As Any) As Long
    Private Declare PtrSafe Function IIDFromString Lib "ole32.dll" (ByVal lpsz As LongPtr, lpiid As GUID) As LongPtr
    Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hClient As LongPtr, ByVal Msg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL] 
    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 ObjectFromLresult Lib "oleacc" (ByVal lResult As Long, riid As Any, ByVal wParam As Long, ppvObject As Any) As Long
    Private Declare Function IIDFromString Lib "ole32.dll" (ByVal lpsz As Long, lpiid As GUID) As Long
    Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hClient As Long, ByVal Msg As Long, ByVal wParam As Long, lParam As Any) As Long
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If

Private Const WM_GETOBJECT = &H3D&
Private Const OBJID_NATIVEOM = &HFFFFFFF0
Private Const S_OK = 0

  
Sub Test()
    [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL]  VBA7 Then
        Dim hwnd As LongPtr, lResult As LongPtr
    [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL] 
        Dim hwnd As Long, lResult As Long
    [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL]  If
    
    Const IID_IDISPATCH = "{00020400-0000-0000-C000-000000000046}"
    Dim uGUID As GUID
    Dim oBook As Object
    Dim t As Single
    
    t = Timer
    Do
        DoEvents
    Loop Until Timer - t >= 1
     
    hwnd = FindWindowEx(0, Application.hwnd, "XLMAIN", vbNullString)
    hwnd = FindWindowEx(hwnd, 0, "XLDESK", vbNullString)
    hwnd = FindWindowEx(hwnd, 0, "EXCEL7", vbNullString)
    lResult = SendMessage(hwnd, WM_GETOBJECT, 0, ByVal OBJID_NATIVEOM)
    If lResult Then
        If IIDFromString(StrPtr(IID_IDISPATCH), uGUID) = S_OK Then
            If ObjectFromLresult(lResult, uGUID, 0, oBook) = S_OK Then
                If Not oBook Is Nothing Then
                    [B][COLOR=#0000ff]MsgBox oBook.Application.Workbooks(1).Name[/COLOR][/B]
                End If
            End If
        End If
    Else
        MsgBox "Book1 not accessible"
    End If

End Sub

Does the MsgBox display Book1 ?

 

[themick]

Thank you for your help. No, it says "Book1 not available", thank you
m