Question

我有一个外部程序，它从具有特定参数（CREO）的批处理中启动excel，然后移动，读取文本文件并将部分数据转储到现有的excel文件中。一切都运行正常，除非另一个用户有excel表，它应该将数据转储为打开。然后我的脚本用＆＃34;提示用户另一个用户打开文件，在XXX文件关闭后手动重新运行批处理文件＆＃34;

但是，其他用户可能实际上是同一个用户，因为批处理脚本启动了一个新的excel实例。是否有方法在同一用户运行的另一个excel实例中引用工作簿？

这是我的getworkbook方法：

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

以及检查该文件是否被另一个实例使用的函数：

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

这是我的批处理脚本代码，用于激活第二个实例，然后该实例应该执行该实例中的所有操作，或者如果该实例打开工作簿，则切换到另一个实例。

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

Answer 1

这很棘手。您必须使用API调用的组合。下面是我为了找到多个Excel实例并执行指定的操作（检查它是否存在，查看它是否隐藏，更改窗口可见性或关闭应用程序）而不是解释它是如何工作的。请随意尝试一下，看看它是否适合您的情况。

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

从另一个excel实例获取excel实例

1 个答案: