Inventor VBA accessing factory table via excel late binding

[marcus_scheinberger]

Hello together,

i tried to access a ipart factory table via vba with excel late binding.

I have to use late binding, because we have different versions of excel running in our company and an early binding will lead into problems.

My code works well in case a excel task (in taskmanager) is already running.

When i run my code without an running excel task a new task is created but i cannot access the spreadsheet because it is write protected.

Here is my code and i would appreciate to get an idea how i can solve this problem.

Private Sub AccessFactoryTable()
    
    Debug.Print ""
    Debug.Print "________________________________"
    Debug.Print ""
    Debug.Print "    Creating factory table"
    Debug.Print ""
    
    Dim oDoc As Object
    Set oDoc = ThisApplication.ActiveDocument
    
    ' detecting %TEMP%-Dir...
    Dim TempDir As String
    If Len(Environ$("tmp")) <> 0 Then
        TempDir = Environ$("tmp") & "\"
        Else
            If Len(Environ$("temp")) <> 0 Then
                TempDir = Environ$("temp") & "\"
                Else
                MsgBox "The %TEMP%-Dir could not be detected!", vbCritical + vbOKOnly
            End If
    End If
    'Debug.Print "TempDir: "; TempDir
    
    
    Err.Clear
    Set iPartFactory = oDoc.ComponentDefinition.iPartFactory
    If Err > 0 Or iPartFactory Is Nothing Then
        If MsgBox("Would you like to cerate an iPart?", vbQuestion + vbYesNo, "AccessFactoryTable") = vbNo Then
            End
        Else
            Set iPartFactory = oDoc.ComponentDefinition.CreateFactory
            Set iPartFactory = oDoc.ComponentDefinition.iPartFactory
        End If
    End If
    
                  
    ' Test if ExcelObject is available, if not create one...
    On Error Resume Next
    'Dim xlWorkbook As Object
    Err.Clear
    Set xlWorkbook = GetObject(, "Excel.Application")
    If Err.Number <> 0 Then
        Debug.Print "Excel is not running! - starting Excel..."
        Err.Clear
        On Error Resume Next
        Set xlWorkbook = CreateObject("Excel.Application")
        If Err.Number <> 0 Then
             Err.Clear
             MsgBox ("Could not open Excel!")
             Exit Sub
        End If
    End If

    xlWorkbook.Visible = True
    'xlWorkbook.Visible = False
    xlWorkbook.Application.DisplayAlerts = False
    
    Dim xlFile As String
          
           
    ' Excel factory table
    xlFile = TempDir & Mid(iPartFactory.ExcelWorksheet.Names.Application.Caption, 19, 33)
    Debug.Print "xlFile: "; xlFile
             
    'Set iPartFactory = Nothing
             
     xlWorkbook.Workbooks.Open FileName:=xlFile
     'Set xlWorkbook = iPartFactory.ExcelWorksheet
          
    Dim oCellRng As Object
    Set oCellRng = xlWorkbook.Cells
    
    Dim oColumnRng As Object
    Set oColumnRng = xlWorkbook.Columns
          
    Debug.Print "Creating column: Test"
    oColumnRng(3).EntireColumn.Insert ' Insert a new column to avoid that existing cells get deleted
    oCellRng.Item(1, 3) = "Test"
    oCellRng.Item(2, 3) = "0"
    
    xlWorkbook.Save
    xlWorkbook.Close (True)
    xlWorkbook.Quit
    
    Set xlWorkbook = Nothing
    oDoc.Update
      
End Sub

[Vladimir.Ananyev]

I have changed your code a little to make more clear different Excel objects – Excel.Application, Workbook, Worksheet, Range.

This works on my side as expected both when Excel is running and when this code has to start new Excel session.

Private Sub AccessExcelApp()
                  
    ' Test if ExcelObject is available, if not create one...
    On Error Resume Next
    Err.Clear
    Dim xlApp As Excel.Application
    Set xlApp = GetObject(, "Excel.Application")
    If Err.Number <> 0 Then
        Debug.Print "Excel is not running! - starting Excel..."
        Err.Clear
        On Error Resume Next
        Set xlApp = CreateObject("Excel.Application")
        If Err.Number <> 0 Then
             Err.Clear
             MsgBox ("Could not open Excel!")
             Exit Sub
        End If
    End If
    xlApp.Visible = True
    xlApp.Application.DisplayAlerts = False
    
    'define some filename
    Dim xlFile As String
    xlFile = "C:\temp\DATA.xlsx"
             
    'open workbook
    Dim xlWorkbook As Excel.Workbook
    Set xlWorkbook = xlApp.Workbooks.Open(xlFile)
    
    'get the reference to the active worksheet
    Dim xlSheet As Excel.WorkSheet
    Set xlSheet = xlWorkbook.ActiveSheet
    
    'get the reference to the worksheet cell specified by row and column numbers
    Dim oCellRng As Excel.Range
    Set oCellRng = xlSheet.Cells(3, 2)
    'print the cell value
    Debug.Print oCellRng.value
    oCellRng.value = xlApp.WorksheetFunction.PI()
    
    Stop   '  <-- for debug purpose only
    
'    xlWorkbook.Save
    xlWorkbook.Close (False)
    
    xlApp.Quit
    Set xlApp = Nothing
End Sub