I would like to create a macro that finds multiple points from multiple 3d sketches and exports the data into a message box and Excel in model coordinates. I've tried various macros online, but none of them seem to compile due to various runtime errors.

I also tried the code in the below links but that did not work either:

https://forum.solidworks.com/thread/91728

I always get a "Runtime error 424: Object required" error (or similar ones), whether I try the code in the above link or my code below. Do I have to do something differently in SolidWorks 2016, or is it just overly complicated?

Option Explicit

Dim xlApp As Excel.Application

Dim xlWorkbook As Excel.Workbook

Public Function GetModelCoordinates _

( _

    swApp As SldWorks.SldWorks, _

    swPoint As SldWorks.MathPoint, _

    vPtArr As Variant _

) As Variant

    Dim swMathPt As SldWorks.MathPoint

    Dim swMathUtil As SldWorks.MathUtility

    Dim swMathTrans As SldWorks.MathTransform

    Set swMathUtil = swApp.GetMathUtility

    Set swMathPt = swMathUtil.CreatePoint(vPtArr)

    Set swMathTrans = SldWorks.MathTransform

    Set swMathTrans = swMathTrans.Inverse

    Set swMathPt = swMathPt.MultiplyTransform(swMathTrans)

    GetModelCoordinates = swMathPt.ArrayData

End Function

Sub Main()

    'On Error Resume Next

    Dim swApp As SldWorks.SldWorks

    Dim swModel As SldWorks.ModelDoc2

    Dim swMathUtil As SldWorks.MathUtility

    Dim swSelMgr As SldWorks.SelectionMgr

    Dim vPt1 As Variant

    Dim dArr(2) As Double

    Dim i As Long

    Dim j As Long

    Dim l As Long

    Dim m As Long

    Dim n As Long

    Dim dArrUnit As Variant

    Dim bRes As Boolean

    Dim Message As String

    Dim startRow As Double

    Dim swPoint As SldWorks.SketchPoint

    Dim NumberOfSelectedItems

    Dim swSelBody As SldWorks.Body2

    Dim vModelSelPt1 As Variant

    Dim DEC As Double

    Dim swSketch As SldWorks.Sketch

    Const UnitFactor As Double = 1000 'Get from m to mm

    Set swApp = Application.SldWorks

    Set swModel = swApp.ActiveDoc

    Set swSelMgr = swModel.SelectionManager

    Set swSketch = swModel.GetActiveSketch2

    If Not swApp Is Nothing Then

        Set swModel = swApp.ActiveDoc

        Set swMathUtil = swApp.GetMathUtility

        If Not swModel Is Nothing And Not swMathUtil Is Nothing Then

            Set swSelMgr = swModel.SelectionManager

            NumberOfSelectedItems = swSelMgr.GetSelectedObjectCount2(-1)

            If NumberOfSelectedItems > 0 Then

                'initialize Excel

                Call GetExcel

            End If

            For l = 1 To NumberOfSelectedItems

               Set swPoint = swSelMgr.GetSelectionPoint2(l, -1)

               If Not swPoint Is Nothing Then

                   Set swPoint = swPoint.GetPoint2

                   DEC = 6

                   dArr(0) = FormatNumber(swPoint.X, DEC)

                   dArr(1) = FormatNumber(swPoint.Y, DEC)

                   dArr(2) = FormatNumber(swPoint.Z, DEC)

                   vPt1 = dArr

                    vModelSelPt1 = GetModelCoordinates(swApp, swPoint, vPt1)

                        Message = Message & "Coordinates for Centerpoint is " & vbCrLf & "X: " & (vModelSelPt1(0) * UnitFactor) & " mm" & " Y: " & (vModelSelPt1(1) * UnitFactor) & " mm" & " Z: " & (vModelSelPt1(2) * UnitFactor) & " mm" & vbCrLf

                    'write two lines to Excel, so startrow is counted by 2

                    bRes = WriteToExcel(((l - 1) * 2) + 1, vModelSelPt1, "Coordinates from Centerpoint")

                End If

            Next l

startRow = 1

    For m = 1 To NumberOfSelectedItems

    For n = 1 To 3 Step 2

    With xlWorkbook.ActiveSheet

    startRow = (4 * m) + n - 2

        .Cells(startRow, 1).Value = "i"

        .Cells(startRow, 2).Value = "j"

        .Cells(startRow, 3).Value = "k"

    End With

    Next n

    Next m

            Set swSelMgr = Nothing

            Set swPoint = Nothing

        End If

        Set swModel = Nothing

        Set swMathUtil = Nothing

    End If

'show the message

MsgBox Message

End Sub

Private Sub GetExcel()

    Set xlApp = CreateObject("Excel.Application")

    xlApp.Visible = True

    Set xlWorkbook = xlApp.Workbooks.Add

End Sub

Private Function WriteToExcel(startRow As Integer, data As Variant, Optional label As String = "") As Boolean

    'get the results into excel

    With xlWorkbook.ActiveSheet

        .Cells(startRow, 1).Value = "X"

        .Cells(startRow, 2).Value = "Y"

        .Cells(startRow, 3).Value = "Z"

        .Cells(startRow, 4).Value = label

        .Cells(startRow + 1, 1).Value = data(0)

        .Cells(startRow + 1, 2).Value = data(1)

        .Cells(startRow + 1, 3).Value = data(2)

    End With

End Function

Thanks for any assistance!