VBA Reference to Excel 2010 click-to-run

Question

I need to output some information from Solidworks to Excel using a macro, but running it returns and error and in the references in VBA I get :

"MISSING: Microsoft Excel 14 Object Library"

which displays a path that does not go the Excel.exe file.

The problem is that, with my click-to-run version of Excel, the true excel.exe is hidden on the Q drive that office creates, and I cannot access nor see it (path is Q:\140062.enu\Office14\EXCEL.EXE but I cannot open the drive) and so I can't manually create a new reference to it. Is there a way around this?

Answer 1

Can you change the code? Is so, you should change, for example,

Sub Example()
    Dim xlApp As Excel.Application
    Dim rng As Excel.Range
    '...

Into:

Sub Example()
    Dim xlApp As Object 'Excel.Application
    Dim rng As Object 'Excel.Range
    '...

---

Felipe Costa Gualberto - http://www.ambienteoffice.com.br

Answer 2

The code I'm trying to run is below. I've gotten it working by outputing to a text file instead Excel, and then importing it by hand, but for future reference it'd still be useful to know how to make that reference.

I tried changing the variable dimensions as you mentioned but it still breaks when it tries to make the worksheets.

--------------------------------------

Option Explicit

Const FMAT As String = "0.00"
Const SF As Double =
1000

Dim swApp As SldWorks.SldWorks
Dim Part As SldWorks.ModelDoc2
Dim Feature As SldWorks.Feature
Dim myRefPoint As SldWorks.RefPoint

Dim myMathPt As SldWorks.MathPoint
Dim ptData As Variant
Dim xlApp
As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As
Excel.Worksheet
Const FirstRow As Long = 4
Const FirstCol As Long = 2

Dim CurRow As Long
Dim IDCol As Long
Dim Xcol As Long
Dim Ycol
As Long
Dim Zcol As Long
Dim PtID As Variant
Dim i As Long


Sub main()

Set swApp = Application.SldWorks
Set Part =
swApp.ActiveDoc

Set xlApp = CreateObject("Excel.Application")

xlApp.Visible = True
Set xlBook = xlApp.Workbooks.Add
Set xlSheet =
xlBook.Worksheets("Sheet1")

CurRow = FirstRow
IDCol = FirstCol

Xcol = FirstCol + 1
Ycol = FirstCol + 2
Zcol = FirstCol + 3

xlSheet.Cells(CurRow, IDCol).Value = "'Point ID"
xlSheet.Cells(CurRow,
Xcol).Value = "'X Coord"
xlSheet.Cells(CurRow, Ycol).Value = "'Y Coord"

xlSheet.Cells(CurRow, Zcol).Value = "'Z Coord"
CurRow = CurRow + 1


Set Feature = Part.FirstFeature
While Not Feature Is Nothing
If
Feature.GetTypeName2 = "RefPoint" Then
Set myRefPoint =
Feature.GetSpecificFeature2
Set myMathPt = myRefPoint.GetRefPoint
ptData
= myMathPt.ArrayData
xlSheet.Cells(CurRow, IDCol).Value = Feature.Name

xlSheet.Cells(CurRow, Xcol).Value = Format(ptData(0) * SF, FMAT)

xlSheet.Cells(CurRow, Ycol).Value = Format(ptData(1) * SF, FMAT)

xlSheet.Cells(CurRow, Zcol).Value = Format(ptData(2) * SF, FMAT)
CurRow
= CurRow + 1
End If
Set Feature = Feature.GetNextFeature
Wend


End Sub

Answer 3

If Office is installed with Click-to-Run (eg limited trial) automation is not supported. There is no workaround other than to fully install.

http://office.microsoft.com/en-us/excel-help/click-to-run-switch-to-using-an-msi-based-office-edition-HA101850538.aspx

Peter Thornton

Answer 4

Probably it is what Peter said. However, if it's not the case, try running the code below:

Const FMAT As String = "0.00"
Const SF As Double = 1000

Dim swApp As SldWorks.SldWorks
Dim Part As SldWorks.ModelDoc2
Dim Feature As SldWorks.Feature
Dim myRefPoint As SldWorks.RefPoint

Dim myMathPt As SldWorks.MathPoint
Dim ptData As Variant
Dim xlApp As Object 'Excel.Application
Dim xlBook As Object 'Excel.Workbook
Dim xlSheet As Object 'Excel.Worksheet
Const FirstRow As Long = 4
Const FirstCol As Long = 2

Dim CurRow As Long
Dim IDCol As Long
Dim Xcol As Long
Dim Ycol As Long
Dim Zcol As Long
Dim PtID As Variant
Dim i As Long


Sub main()

    Set swApp = Application.SldWorks
    Set Part = swApp.ActiveDoc

    Set xlApp = CreateObject("Excel.Application")

    xlApp.Visible = True
    Set xlBook = xlApp.Workbooks.Add
    Set xlSheet = xlBook.Worksheets(1)

    CurRow = FirstRow
    IDCol = FirstCol

    Xcol = FirstCol + 1
    Ycol = FirstCol + 2
    Zcol = FirstCol + 3

    xlSheet.Cells(CurRow, IDCol).Value = "'Point ID"
    xlSheet.Cells(CurRow, Xcol).Value = "'X Coord"
    xlSheet.Cells(CurRow, Ycol).Value = "'Y Coord"

    xlSheet.Cells(CurRow, Zcol).Value = "'Z Coord"
    CurRow = CurRow + 1

    Set Feature = Part.FirstFeature
    While Not Feature Is Nothing
        If Feature.GetTypeName2 = "RefPoint" Then
            Set myRefPoint = Feature.GetSpecificFeature2
            Set myMathPt = myRefPoint.GetRefPoint
            ptData = myMathPt.ArrayData
            xlSheet.Cells(CurRow, IDCol).Value = Feature.Name

            xlSheet.Cells(CurRow, Xcol).Value = Format(ptData(0) * SF, FMAT)

            xlSheet.Cells(CurRow, Ycol).Value = Format(ptData(1) * SF, FMAT)

            xlSheet.Cells(CurRow, Zcol).Value = Format(ptData(2) * SF, FMAT)
            CurRow = CurRow + 1
        End If
        Set Feature = Feature.GetNextFeature
    Wend
End Sub

---

Felipe Costa Gualberto - http://www.ambienteoffice.com.br

Answer 5

No luck with that code, fails on the Set xlApp = CreateObject("Excel.Application") line.

Figured it might just be the case that this version of Excel didn't support this. Thanks for your help anyways.