Home » excel » Check for open Excel file before automating opening and searching from Access with VBA

Check for open Excel file before automating opening and searching from Access with VBA

Posted by: admin May 14, 2020 Leave a comment

Questions:

I have compiled the following routine with a lot of help (thank you kind people), to open an excel spreadsheet from an Access database form, and search through the worksheets for a string lifted from a form control. I would now like the routine to check if the Workbook is open and to use an open instance rather than opening a new instance of the workbook. I have tried to close the Excel application but this seems a very heavy way of doing what I want to achieve and using an already open file would be quicker and more elegant. Please can someone help me with this. thanks

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

This is the edited routine that does not re-open Excel if already open and successfully finds strings across a workbook. I dont use the boolean Excelwasnotrunning and that should be removed. I think my logic in the first section (_ If Err.Number = 0 Then GoTo 1
If Err.Number <> 0 Then_) could be improved.
Thanks for help again.



    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
How to&Answers:

Consider:

' 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

For more info review http://accessmvp.com/KDSnell/EXCEL_MainPage.htm