Solidworks Macro - BOM 1

Workbooks.Open FileName:= _
    "C:\YourFile.xls", ReadOnly:=True _
    Workbooks.Application.Visible = True

    'Change a cell
    Range("B2").FormulaR1C1 = sEqn

Workbooks.Close

Option Explicit

Dim swApp As Object
Dim swPart As Object
Dim swView As Object
Dim swBOM As Object

Public Type BOM_Data
    Rev As String
    Item As String
    Qty As String
    Desc As String
    Wgt As String
    Matl As String
    Spec1 As String
    Spec2 As String
    PartNo As String
End Type
Public LineItem() As BOM_Data

Sub main()
    Dim ret As Variant, sTmp As String
    Dim i As Integer, iItems As Integer
    Dim sMisc(7) As String
    
    Dim BomViewsModelName As String
    Dim dataArray As Variant
    
    'Attach to SolidWorks
    On Error Resume Next
    Set swApp = GetObject(, "SldWorks.Application")
    If Err.Number <> 0 Then
        MsgBox &quot;Can not Find SldWorks.Application&quot; & vbCrLf & _
               &quot;ErrNo: &quot; & Err.Number & &quot;  ErrMsg: &quot; & Err.Description _
               , vbOKOnly, &quot;Error in ExportBOM()&quot;
        Err.Clear
        Exit Sub
    End If
    
    On Error GoTo 0

    'Comment this out to debug
    On Error GoTo ErrorEB

    Set swPart = swApp.ActiveDoc
    Set swView = swPart.GetFirstView        'This is actually the template
    
    'Get the BOM
    Set swBOM = swView.GetBomTable
    'Find the BOM - must find the view that contains the BOM
    Do While swBOM Is Nothing And Not swView Is Nothing
        Set swView = swView.GetNextView
        Set swBOM = swView.GetBomTable
    Loop
    If swBOM Is Nothing Then
        MsgBox &quot;Can NOT find a BOM on the current drawing!&quot;
        Exit Sub
    End If
    'Attach to the BOM
    ret = swBOM.Attach2
    If ret = False Then
        MsgBox &quot;Error Attaching to BOM&quot;
        Exit Sub
    End If
    'Put the BOM table in an array
    iItems = swBOM.GetRowCount - 1
    ReDim LineItem(iItems)
    For i = 1 To iItems
        LineItem(i).Rev = swBOM.GetEntryText(i, 0)
        LineItem(i).Item = swBOM.GetEntryText(i, 1)
        LineItem(i).Qty = swBOM.GetEntryText(i, 2)
        LineItem(i).Desc = swBOM.GetEntryText(i, 3)
        LineItem(i).Wgt = swBOM.GetEntryText(i, 4)
        LineItem(i).Matl = swBOM.GetEntryText(i, 5)
        LineItem(i).Spec1 = swBOM.GetEntryText(i, 6)
        LineItem(i).Spec2 = swBOM.GetEntryText(i, 7)
        LineItem(i).PartNo = swBOM.GetEntryText(i, 8)
    Next i
    'Detach from the BOM
    swBOM.Detach
    
    'Convert Linked Dimensions Here - Skipped
    
    'Open the Excel File
    'Use Workbooks.Open to open an existing file
    Workbooks.Add
    Workbooks.Application.Visible = True
    'Write out the data
    For i = 1 To iItems
        Range(&quot;A&quot; & i).FormulaR1C1 = LineItem(i).Rev
        Range(&quot;B&quot; & i).FormulaR1C1 = LineItem(i).Item
        Range(&quot;C&quot; & i).FormulaR1C1 = LineItem(i).Qty
        Range(&quot;D&quot; & i).FormulaR1C1 = LineItem(i).Desc
        Range(&quot;E&quot; & i).FormulaR1C1 = LineItem(i).Wgt
        Range(&quot;F&quot; & i).FormulaR1C1 = LineItem(i).Matl
        Range(&quot;G&quot; & i).FormulaR1C1 = LineItem(i).Spec1 & Space(2) & LineItem(i).Spec2
        Range(&quot;H&quot; & i).FormulaR1C1 = LineItem(i).PartNo
    Next i
    Range(&quot;A4&quot;).Select
    
    '***************************************
    'Rearrange and Print the Excel File Here
    '***************************************
    
    MsgBox &quot;BOM Exported Successfully!&quot;
    GoTo CleanUp
ErrorEB:
    MsgBox &quot;Error in ExportBOM() Utility&quot; & vbCrLf & Err.Description
    Err.Clear
CleanUp:
    Set swApp = Nothing
    Set swPart = Nothing
    Set swView = Nothing
    Set swBOM = Nothing
End Sub

Public Sub GetTitleBlockValues()
    Dim View As Object
    Dim note
    Dim sNoteName As String
    Dim sTitle As String, sDescription As String
    
    '(WITH THE DRAWING FILE OPEN)
    
    Part.EditTemplate
    
    'This is actually the template
    Set View = Part.GetFirstView
    
    'Get First Note Object
    Set note = View.GetFirstNote
    
    Do While Not note Is Nothing
        sNoteName = note.GetName
        
        'Get data if we have the right note
        If sNoteName Like "NoteNameOfTheDescription" Then
            sDescription = note.GetText
        ElseIf sNoteName Like "NoteNameOfTheTitle" Then
            sTitle = note.GetText
        End If
        
        Set note = note.GetNext
    
    Loop
    Part.EditSheet
End Sub

Option Explicit

'<><><><><><><><><><><><><><><><><><><><><><><><><><><><><>
' ChangeNoteName
'<><><><><><><><><><><><><><><><><><><><><><><><><><><><><>
Dim swApp As Object
Dim Model As Object
Dim SelMgr As Object
Dim note As Object
Dim annotation As Object
Dim sName As String
Dim sMsg As String
Dim res
Const swSelNOTES = 15
Const swDocDRAWING = 3

Sub Main()
    Set swApp = CreateObject(&quot;SldWorks.Application&quot;)
    Set Model = swApp.ActiveDoc
    'Verify a Drawing is Opened
    If (Model Is Nothing) Or (Model.GetType <> swDocDRAWING) Then
            MsgBox &quot;You Must Have a Drawing Opened&quot;
            Exit Sub
    End If
    'Verify a Note is Selected
    Set SelMgr = Model.SelectionManager
    If (SelMgr.GetSelectedObjectCount = 0) Then
            MsgBox &quot;You Need to Select a Note First&quot;
            Exit Sub
    End If
    If (SelMgr.GetSelectedObjectCount > 1) Then
            MsgBox &quot;Select Only One Note&quot;
            Exit Sub
    End If
    'NOTE
    ElseIf (SelMgr.GetSelectedObjectType(1) = swSelNOTES) Then
        Set note = SelMgr.GetSelectedObject2(1)
        sMsg = &quot;Change Name From &quot; & note.GetName & &quot; To What?&quot;
        sName = InputBox(sMsg, &quot;Change Note Name&quot;, &quot;&quot;)
        If Len(sName) > 0 Then
            res = note.SetName(sName)
            'Verify the Name Was Changed Properly
            If (note.GetName <> sName) Then
                MsgBox &quot;Error Changing Name!&quot;
            Else
                MsgBox &quot;Note Name Was Changed To &quot; & sName
            End If
        Else
            MsgBox &quot;ChangeNoteName Cancelled&quot;
        End If
    'INVALID
    Else
        MsgBox &quot;The Selected Item is Not a Valid Note&quot;
    End If
End Sub