Проверьте наличие открытого файла Excel, прежде чем автоматизировать открытие и поиск из Access с VBA

Question

Я скомпилировал следующую подпрограмму с большой помощью (спасибо, добрые люди), чтобы открыть электронную таблицу Excel из формы базы данных Access и найти в рабочих таблицах строку, извлеченную из элемента управления формы. Теперь я хотел бы, чтобы процедура проверяла открытость рабочей книги и использовала открытый экземпляр, а не открывала новый экземпляр рабочей книги. Я пытался закрыть приложение Excel, но это, кажется, очень тяжелый способ сделать то, что я хочу достичь, и использование уже открытого файла было бы быстрее и элегантнее. Пожалуйста, кто-нибудь может мне помочь с этим. спасибо

Private Sub Command132_Click()

On Error GoTo Err_Command132_Click

Dim filename As String
Dim searchstring As String

Dim xlApp As Excel.Application 'Excel object
Dim XlBook As Excel.Workbook 'Workbook object
Dim Xlsheet As Excel.Worksheet 'Worksheet object
Dim foundCell As Range

Set xlApp = CreateObject("Excel.Application")
searchstring = Me.Matrixsrch
filename = Me.GroupsMatrixLoccntrl
Set XlBook = xlApp.Workbooks.Open(filename)
xlApp.Visible = True
xlApp.ActiveWindow.WindowState = xlMaximized

For Each Xlsheet In XlBook.Worksheets
    With Xlsheet
                Set foundCell = .Cells.Find(What:=searchstring, _
                                    After:=.Cells(1, 1), _
                                    LookIn:=xlvalues, _
                                    LookAt:=xlPart, _
                                    SearchOrder:=xlByRows, _
                                    SearchDirection:=xlNext, _
                                    MatchCase:=False, _
                                    SearchFormat:=False) _

        If Not foundCell Is Nothing Then
             .Activate
             foundCell.Select
             MsgBox "Unit found"
             Exit For
             End If
    End With
Next

If foundCell Is Nothing Then MsgBox "No unit found"

Exit_Command132_Click:
    Exit Sub

Err_Command132_Click:
    MsgBox "Error " & Err.Number & "; " & Err.Description
   Debug.Print "Error " & Err.Number & "; " & Err.Description
    Resume Exit_Command132_Click

End Sub

Это отредактированная процедура, которая не открывает заново Excel, если он уже открыт, и успешно находит строки в книге. Я не использую логическое Excelwasnotrunning , и это должно быть удалено. Я думаю, что мои логи c в первом разделе (_ If Err.Number = 0, затем GoTo 1 If Err.Number <> 0 Then_) могут быть улучшены. Еще раз спасибо за помощь.

    Private Sub Command132_Click()

    Dim filename As String
    Dim searchstring As String
    Dim xlObj As Object
    Dim xlApp As Excel.Application 'Excel object
    Dim XlBook As Excel.Workbook 'Workbook object
    Dim Xlsheet As Excel.Worksheet 'Worksheet object
    Dim foundCell As Range
    Dim ExcelWasNotRunning As Boolean    ' Flag for final release.

    On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application")
    If Err.Number = 0 Then GoTo 1
    If Err.Number <> 0 Then
          Set xlApp = CreateObject("Excel.Application")
          ExcelWasNotRunning = True
    End If
    Err.Clear
    On Error GoTo Err_Command132_Click 'reset error behaviour

    Set xlApp = CreateObject("Excel.Application")

    1:
    searchstring = Me.Matrixsrch
    filename = Me.GroupsMatrixLoccntrl
    Set XlBook = xlApp.Workbooks.Open(filename)
    xlApp.Visible = True
    xlApp.ActiveWindow.WindowState = xlMaximized

    For Each Xlsheet In XlBook.Worksheets
        With Xlsheet
                    Set foundCell = .Cells.Find(What:=searchstring, _
                                        After:=.Cells(1, 1), _
                                        LookIn:=xlvalues, _
                                        LookAt:=xlPart, _
                                        SearchOrder:=xlByRows, _
                                        SearchDirection:=xlNext, _
                                        MatchCase:=False, _
                                        SearchFormat:=False) _

            If Not foundCell Is Nothing Then
                 .Activate
                 foundCell.Select
                 'MsgBox "Unit found"
                 Exit For
                 End If
        End With
    Next

    If foundCell Is Nothing Then MsgBox "No unit found"

    Exit_Command132_Click:
        Exit Sub

    Err_Command132_Click:
        MsgBox "Error " & Err.Number & "; " & Err.Description
       Debug.Print "Error " & Err.Number & "; " & Err.Description
        Resume Exit_Command132_Click

    End Sub

Answer 1

Рассмотрим:

' Establish an EXCEL application object
On Error Resume Next
Set objExcel = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
      Set objExcel = CreateObject("Excel.Application")
      blnEXCEL = True
End If
Err.Clear
On Error GoTo 0

Для получения дополнительной информации обзора http://accessmvp.com/KDSnell/EXCEL_MainPage.htm