Opening Excel only once from AutoCAD 2014 VBA

[Anonymous]

I am trying to open an excel from a Autocad 2014 VBA, this works fine, however, I do not want the file to re-open if it is already open. I did a lot of research and found the following code, which does not work. I included the excel file for reference, you will have to update the folder if you want to run it. Again, I can open the file but I want to skip re-opening it if it is already open. input please. I have already tried varients on the 

Set Test_wb = objExcel.Workbooks(Name)

using File as well does not work. I also used the code from here: https://www.experts-exchange.com/questions/28950354/My-myFile-xlsm-2010-file-is-already-open-how-can.... it seems to work fine if in excel vba. 

Sub Test_Open_Excel()
    Dim i As Integer
    Dim wb, Test_wb As Workbook
    Dim folder, File, Name As String
    
    Set objExcel = CreateObject("Excel.Application")
    
    folder = "C:\Users\T6145M1\Desktop\Files\Programing\VBA for AutoCAD\"
    Name = "Conceptual_Flow_Excel.xlsm"
    File = folder & Name
    
    On Error Resume Next
    Set Test_wb = objExcel.Workbooks(Name)
    On Error GoTo 0
    
    'If workbook is not opened, Test_wb will be nothing and you can attempt to open it
    If Test_wb Is Nothing Then
       Set wb = objExcel.Workbooks.Open(File, , False)
       objExcel.Application.Visible = True
    Else
       Set wb = objExcel.Workbooks(File)
    End If
             
    wb.Activate
End Sub

[norman.yuan]

The code should do things in this way:

1. Try to get an existing Excel application. If no Excel application is running, start a new Excel application session;

2. Loop through all the Workbooks in the Excel application, to see if the Excel file (Workbook) is open or not. If not, open.

Here is the sample code (off my head, not tested)

'' in the module/class, delare variables

Private excelApp As Excel.Application

Private wk As Excel.Workbook

Private Sub GetExcelObjects(fileName as String)

    Set excelApp=Nothing

    Set wk=Nothing

    '' Make sure Excel application is running

    On Error Resume Next

    Set excelApp=GetObject( , "Excel.Application")

    If excelApp Is Nothing Then

        Set excelApp=CreateObject("Excel.Application")

        If excelApp Is Nothing Then

            MsgBox "Cannot start Excel Application!"

            Exit Sub

        End If

    End if

    '' Make sure the Workbook is open

    On Error GoTo 0

    Dim w As Excel.Workbook

    For Each w In excelApp.Workbooks

        If UCase(w.FullName)=UCase(fileName) Then

            Set wk=w

            Exit Sub

        End if

    Next

    On Error Resume Next

    If wk Is Nothing Then

        Set wk = excelApp.Workbooks.Open(fileName, , False)

    End If

    If wk Is Nothing Then

        MsgBox "Cannot open file: " & vbCrlf & fileName

    Else

        wk.Activate

    End If

End Sub

HTH

[Anonymous]

I had to make 1 change but this seems to work very well, I will continue to follow up and test it, thanks for your help. 

Private Sub GetExcelObjects()
    Dim excelApp As Excel.Application
    Dim wb As Excel.Workbook
    Dim folder, Name, FileName As String
    Dim ExcelWasNotRunning As Boolean

    Set excelApp = Nothing
    Set wb = Nothing

    folder = "C:\Users\T6145M1\Desktop\Files\Programing\VBA for AutoCAD\"
    Name = "Conceptual_Flow_Excel.xlsm"
    FileName = folder & Name

    '' Make sure Excel application is running

    On Error Resume Next
    Set excelApp = GetObject(, "Excel.Application")
    If Err.Number <> 0 Then ExcelWasNotRunning = True
    Err.Clear    ' Clear Err object in case error occurred.
    
    If ExcelWasNotRunning Then
        Set excelApp = CreateObject("Excel.Application")
        excelApp.Application.Visible = True
        If excelApp Is Nothing Then
            MsgBox "Cannot start Excel Application!"
            Exit Sub
        End If
    End If

    '' Make sure the Workbook is open
    On Error GoTo 0
    Dim w As Excel.Workbook
    For Each w In excelApp.Workbooks
        If UCase(w.FullName) = UCase(FileName) Then
            Set wb = w
            Exit Sub
        End If
    Next

    On Error Resume Next
    If wb Is Nothing Then
        Set wb = excelApp.Workbooks.Open(FileName, , False)
    End If
    
    If wb Is Nothing Then
        MsgBox "Cannot open file: " & vbCrLf & FileName
    Else
        wb.Activate
    End If

End Sub

[norman.yuan · Accepted solution]

For this part of code:

    If ExcelWasNotRunning Then
        Set excelApp = CreateObject("Excel.Application")
        excelApp.Application.Visible = True
        If excelApp Is Nothing Then
            MsgBox "Cannot start Excel Application!"
            Exit Sub
        End If
    End If

you may want to change it to (otherwise, if excelApp is not created, the code would crash before showing the messagebox):

    If ExcelWasNotRunning Then
        Set excelApp = CreateObject("Excel.Application")
        If excelApp Is Nothing Then
            MsgBox "Cannot start Excel Application!"
            Exit Sub
        Else
            excelApp.Application.Visible = True
        End If
    End If

[Anonymous]

elaborating on @norman.yuan solution

1) you can demand the task of getting an Excel Application instance to a function:

Function GetExcel(excelApp As Excel.Application) As Boolean
    On Error Resume Next
    Set excelApp = GetObject(, "Excel.Application") '<--| try and get a running instance of Excel
    If excelApp Is Nothing Then Set excelApp = CreateObject("Excel.Application") '<--| try opening a new instance of Excel
    GetExcel = Not excelApp Is Nothing '<--| notify the success of the function task
End Function

  which returns either "True" if successful along with a valid Excel instance or "False" along with a null object

2) no need to iterate through workbooks collection to see if a workbook is there: you simply try getting that workbook

Function GetExcelWb(excelApp As Excel.Application, fileName As String, wb As Object) As Boolean
    On Error Resume Next
    Set wb = excelApp.Workbooks(fileName)  '<--| try and get an already opened workbook named after "Name"
    GetExcelWb = Not wb Is Nothing  '<--| notify the success of the function task
End Function

 which returns either "True" if successful along with a valid workbook instance or "False" along with a null object

3) in the same manner you can demand the task of opening a workbook to a function

Function OpenExcelWb(excelApp As Excel.Application, fullFileName As String) As Excel.Workbook
    On Error Resume Next
    Set OpenExcelWb = excelApp.Workbooks.Open(fullFileName)  '<--| try and get the requested workbook
End Function

which either returns the opened workbook or a null object

so that your main sub can be rewritten as follows:

Sub GetExcelObjects()
    Dim excelApp As Excel.Application
    
    If GetExcel(excelApp) Then '<--| if successfully got a Excel instance..
        Dim wb As Excel.Workbook
        Dim folder As String, name As String, fullFileName As String '<--|explicitly define each declared variable, otherwise they'll be implicitly assumed as of Variant type

        folder = "C:\Users\T6145M1\Desktop\Files\Programing\VBA for AutoCAD\"
        name = "Conceptual_Flow_Excel.xlsm"
        fullFileName = folder & name
    
        If Not GetExcelWb(excelApp, name, wb) Then Set wb = OpenExcelWb(excelApp, fullFileName) '<--| if not succesfully found an already opened workbook with given name, then try and open it
    
        If wb Is Nothing Then
            MsgBox "Cannot open file: " & vbCrLf & fullFileName, vbCritical
        Else
            wb.Activate
        End If
    Else
        MsgBox "Cannot start Excel Application!", vbCritical
    End If
    
    Set excelApp = Nothing
End Sub

this way you keep all that "On Error Resume Next"  stuff confined where it's actually needed and your main code more understandable and clean

[Anonymous]

I haven't been able to get this to work. It just doesn't open the file. Did it work for you?

[Anonymous]

So I think part of the problem is that excelApp reads as "Microsoft Excel" even when excel isn't open, so it misses the

If excelApp Is Nothing Then Set excelApp = CreateObject("Excel.Application") '<--| try opening a new instance of Excel

execution.

[Anonymous]

I updated this function with the following:

Function GetExcel(excelApp As Excel.Application) As Boolean
    On Error Resume Next
    Set excelApp = GetObject(, "Excel.Application") '<--| try and get a running instance of Excel
    If excelApp Is Nothing Then Set excelApp = CreateObject("Excel.Application") '<--| try opening a new instance of Excel
    excelApp.Application.Visible = True
    GetExcel = Not excelApp Is Nothing '<--| notify the success of the function task
End Function

now it seems to perform as desired, thanks everyone. 

[Anonymous]

You should take that added red line out of GetExcel function and put it into the “main” sub (i.e. GetExcelObjects()), as follows

Sub GetExcelObjects()
Dim excelApp As Excel.Application

...
If GetExcel(excelApp) Then '<--| if successfully got a Excel instance..
excelApp.Visible = True
Dim wb As Excel.Workbook
...


The reason is that inside GetExcel() function excelApp could still be “Nothing” while after successfully passing the “If GetExcel(excelApp) Then“ check it must be set to a valid object

[continentalcamapign]

If excelApp Is Nothing Then Set excelApp = CreateObject("Excel.Application") '<--| try opening a new instance of Excel

[Ed__Jobe]

---

@continentalcamapign wrote:

If excelApp Is Nothing Then Set excelApp = CreateObject("Excel.Application") '<--| try opening a new instance of Excel

---

First, you should try GetObject function to see if there is an instance of excel already running. If not, it will error. If that happens, only then should you use CreateObject. Otherwise you’ll end up creating a bunch of application objects until you run out of resources.