1

I have an external program which starts up excel from a batch with a specific parameter(CREO) and then moves,reads textfiles and dumps some of this data into an existing excel file. Everything is working fine, except if another user has the excel sheet which it should dump data into open. Then my script prompt the user with" Another user has the file open, rerun the batch file manually after the XXX file has been closed"

However this other user might actually be the same user, because the batch script starts a new instance of excel. Is there a method to reference a workbook in another instance of excel run by the same user?

here is my getworkbook method:

Public Function GetWorkbook(ByVal sFullName As String) As Workbook

    Dim sFile As String
    Dim wbReturn As Workbook

    sFile = Dir(sFullName)

    On Error Resume Next
        Set wbReturn = Workbooks(sFile)


        If wbReturn Is Nothing Then
            If isWorkbookOpen(sFullName) Then
                MsgBox "Workbook open by another user, sorry mate"
                Set wbReturn = Nothing
            Else
                Set wbReturn = Workbooks.Open(sFullName)
            End If
        End If
    On Error GoTo 0

    Set GetWorkbook = wbReturn

End Function

and the function that check if the file is in use by another instance:

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

Here is my batch script code that fires up the second instance which then either should do everything in that instance or switch to the other instance if that instance has the workbook open.

echo "Launch excel"
Set ExcelArgs=CREO

"C:\Program Files (x86)\Microsoft Office\OFFICE16\Excel.exe" /r /e "%APPDATA%\Microsoft\Excel\XLSTART\PERSONAL.XLSB" 

exit 0
4
  • Use GetObject and pass the file path. It will grab a reference to the existing instance, if any, or open it if not. Commented Jun 20, 2016 at 12:08
  • GetObject may work, but it is not reliable. This method will get an instance of Excel, but, if that is not the right one, it will not allow you to then try to get another instance. Commented Jun 20, 2016 at 12:54
  • 2
    @lonestorm That is not correct if you pass a file path. It is true that if you pass just the Excel.Application class, you will get the first instance loaded (since that's what will be registered in the ROT), but passing a file path will either attach to the file if it's open, or open it. Commented Jun 20, 2016 at 13:37
  • My mistake @Rory. Indeed you can use the GetObject method to capture a specific Excel instance if you know the exact path of the desired workbook. 'Set obj = GetObject(wbPath) Set xl = obj.Application'. It is only necessary to use an alternative approach if the file path may change. Commented Jun 20, 2016 at 14:39

1 Answer 1

1

This is tricky. You have to use a combination of API calls. Rather than explain how it works, below is some code I put together to find multiple Excel instances and carry out a specified action (check it exists, see if it is hidden, change the window visibility or close the application). Feel free to experiment with this to see if it works for your situation.

Option Explicit
Public resultsReady As Boolean, fidasRunning As Boolean, visEx As Boolean, visIe As Boolean
Private Declare Function GetDesktopWindow Lib "user32" () As Long
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 FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long

Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long

Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long

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
Dim IDispatch As GUID

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

Private Const WM_SETICON = &H80
Private Const GW_HWNDNEXT = 2
Private Const SWP_HIDEWINDOW = &H80
Private Const SWP_SHOWWINDOW = &H40
Private Const NOMOVE = &H2
Private Const NOSIZE = &H1

Private Enum wsFunction
    check_visibility
    toggle_visibility
    close_application
End Enum

Private Function toggleExcelVisability(action As Byte, startWinName As String, Optional check_found As Boolean) As Boolean
' if getVis then return current visibility, otherwise toggle visibility
Dim lngXLHwnd As Long, lngIcon As Long, strBuff As String, lRetVal As Long, winName As String
Dim xlInt As Long, winDT As Long, winE7 As Long, xlInts() As Long, ExcelInstances As Byte
Dim xlApp As Excel.Application, xlWB As Object, setVis As Long

SetIDispatch

'Get a handle to the desktop
winDT = GetDesktopWindow

Do
    'Get the next Excel window
    xlInt = FindWindowEx(GetDesktopWindow, xlInt, "XLMAIN", vbNullString)

    If (Not xlInt = 0) Then

        strBuff = Space(255)
        lRetVal = GetWindowText(xlInt, strBuff, 255)
        winName = Trim(strBuff)

        If (Left(strBuff, Len(startWinName)) = startWinName Or startWinName = vbNullString) Then
            ' check visibility
            winDT = FindWindowEx(xlInt, 0&, "XLDESK", vbNullString)
            winE7 = FindWindowEx(winDT, 0&, "EXCEL7", vbNullString)
            Call AccessibleObjectFromWindow(winE7, OBJID_NATIVEOM, IDispatch, xlWB) 'Get WB object.
            If (Not (xlWB Is Nothing)) Then
                Set xlApp = xlWB.Application
                Select Case action
                Case check_visibility
                    If (check_found) Then
                        toggleExcelVisability = True
                    Else
                        toggleExcelVisability = xlApp.Visible
                    End If
                Case toggle_visibility
                    If (xlApp.Visible) Then
                        setVis = SWP_HIDEWINDOW
                    Else
                        setVis = SWP_SHOWWINDOW
                    End If
                    toggleExcelVisability = Not xlApp.Visible
                    ReDim Preserve xlInts(ExcelInstances)
                    xlInts(ExcelInstances) = xlInt
                    ExcelInstances = ExcelInstances + 1
                Case close_application
                    xlWB.Close
                    xlApp.Quit
                    Set xlWB = Nothing
                    Set xlApp = Nothing
                    toggleExcelVisability = False
                End Select
            End If

        End If
    End If

Loop Until (xlInt = 0)
Debug.Print ExcelInstances

If (Not setVis = 0) Then
    For ExcelInstances = 0 To UBound(xlInts)
        SetWindowPos xlInts(ExcelInstances), 0, 0, 0, 0, 0, 3 + setVis
    Next ExcelInstances
End If

Set xlApp = Nothing
Set xlWB = Nothing
End Function

Private Sub SetIDispatch()
'Defines the IDispatch variable. The interface
'ID is {00020400-0000-0000-C000-000000000046}.
With IDispatch
    .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
Sign up to request clarification or add additional context in comments.

1 Comment

Will look into @Ionestorm code, getobejct seems to work, but will try it more out to see if it fails under certain conditions

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.