macro that checks if part/assembly is excluded from BOM

i have a macro that automatically creates a drawing for every part and assembly in a selected folder. i would like help to modify this so that it skips over any part or assembly that has the exclude from BOM checked. below is the macro script

Option Explicit

Private Const BIF_RETURNONLYFSDIRS As Long = &H1

Private Const BIF_DONTGOBELOWDOMAIN As Long = &H2

Private Const BIF_RETURNFSANCESTORS As Long = &H8

Private Const BIF_BROWSEFORCOMPUTER As Long = &H1000

Private Const BIF_BROWSEFORPRINTER As Long = &H2000

Private Const BIF_BROWSEINCLUDEFILES As Long = &H4000

Private Const MAX_PATH As Long = 260

Dim swDrawing As DrawingDoc

Dim filename As String

Dim ext As String

Dim longerrors As Long, longwarnings As Long

Dim swApp As SldWorks.SldWorks

Dim swSktManager As SldWorks.SketchManager

Dim swModel As SldWorks.ModelDoc2

Dim swModelDocExt As SldWorks.ModelDocExtension

Dim swSheet As SldWorks.Sheet

Dim sPath As String

Dim Path As String

Dim swFilename As String

Dim nErrors As Long

Dim nWarnings As Long

Dim Response As String

Dim DocName As String

Dim bret As Boolean

Dim swDocTypeLong As Long

Dim vConfs As Variant

Dim vPropNames As Variant

Dim i As Integer

Dim j As Integer

Dim fso As New Scripting.FileSystemObject

Dim MYext As String

Dim swCustPropMgr As SldWorks.CustomPropertyManager

Function BrowseFolder(Optional Caption As String, _

Optional InitialFolder As String) As String

Dim SH As Shell32.Shell

Dim F As Shell32.folder

Set SH = New Shell32.Shell

Set F = SH.BrowseForFolder(0&, Caption, BIF_RETURNONLYFSDIRS, InitialFolder)

If Not F Is Nothing Then

BrowseFolder = F.Items.Item.Path

End If

End Function

Sub main()

Set swApp = Application.SldWorks

Path = BrowseFolder()

If Path = "" Then

MsgBox "Please select the path and try again"

End

Else

Path = Path & "\"

End If

BatchFolder Path, ".SLDPRT", ".SLDASM", True

MsgBox "DONE"

End Sub

Sub BatchFolder(folder As String, ext As String, ext2 As String, silent As Boolean)

If Right(folder, 1) <> "\" Then folder = folder & "\"

ChDir (folder)

Response = Dir(folder)

Do Until Response = ""

swFilename = folder & Response

Debug.Print swFilename

MYext = Right(UCase\$(Response), 7)

If MYext = ext Or MYext = ext2 Then 'this is a file type we want, process it

swDocTypeLong = Switch(MYext = ".SLDPRT", swDocPART, MYext = ".SLDDRW", swDocDRAWING, MYext = ".SLDASM", swDocASSEMBLY, True, -1)

Set swModel = swApp.OpenDoc6(swFilename, swDocTypeLong, swOpenDocOptions_Silent, "", nErrors, nWarnings)

Set swModelDocExt = swModel.Extension

vConfs = swModel.GetConfigurationNames

For i = 0 To UBound(vConfs)

Debug.Print " Main: " & vConfs(i)

If vConfs(i) <> "Custom" Then ClearCustPrps (vConfs(i))

Next

swModel.ShowNamedView2 "*Isometric", -1

swModel.ViewZoomtofit2

swModel.ForceRebuild3 False

swModel.Save2 silent

swApp.CloseAllDocuments (True)

End If

Response = Dir

Loop

Dim myFolder As folder

Dim mySub As folder

Set myFolder = fso.GetFolder(folder)

For Each mySub In myFolder.SubFolders

BatchFolder mySub.Path, ext, ext2, silent

Next

End Sub

Sub ClearCustPrps(conf As String)

Set fso = CreateObject("Scripting.FileSystemObject")

Set swApp = Application.SldWorks

Set swModel = swApp.ActiveDoc

If swModel Is Nothing Then Exit Sub

filename = swModel.GetPathName

ext = UCase(Right(filename, 6))

If ext <> "SLDPRT" And ext <> "SLDASM" Then Exit Sub

Dim curfilename As String

curfilename = Left(filename, Len(filename) - 7) & ".SLDDRW"

If fso.FileExists(curfilename) Then

If MsgBox(curfilename & " already exists. Overwrite?", vbYesNo + vbQuestion) = vbNo Then Exit Sub

End If

Dim template As String

template = swApp.GetUserPreferenceStringValue(swDefaultTemplateDrawing)

Set swDrawing = swApp.NewDocument(template, 0, 0, 0)

If swDrawing Is Nothing Then

MsgBox "Failed to create drawing"

Exit Sub

End If

If (ext = "SLDPRT") Then

swApp.OpenDoc6 filename, swDocPART, swOpenDocOptions_ReadOnly, "", longerrors, longwarnings

Else: swApp.OpenDoc6 filename, swDocASSEMBLY, swOpenDocOptions_ReadOnly, "", longerrors, longwarnings

End If

swDrawing.Create3rdAngleViews2 filename

Dim cursheet As Sheet

Dim sheetwidth As Double, sheetheight As Double

Set cursheet = swDrawing.GetCurrentSheet

cursheet.GetSize sheetwidth, sheetheight

Dim view As view

Dim vOutline As Variant, vPosition As Variant

Dim viewWidth As Double, viewHeight As Double

Set view = swDrawing.CreateDrawViewFromModelView3(filename, "*Isometric", sheetwidth, sheetheight, 0)

vOutline = view.GetOutline

vPosition = view.Position

viewWidth = vOutline(2) - vOutline(0)

viewHeight = vOutline(3) - vOutline(1)

vPosition(0) = vPosition(0) - viewWidth

vPosition(1) = vPosition(1) - viewHeight

view.Position = vPosition

Dim v As view

Set v = swDrawing.GetFirstView ' Sheet

Set v = v.GetNextView ' First view

swDrawing.ClearSelection2 True

While Not v Is Nothing

If v.Name <> view.Name Then swDrawing.Extension.SelectByID2 v.Name, "DRAWINGVIEW", 0, 0, 0, True, -1, Nothing, 0

Set v = v.GetNextView

Wend

swDrawing.InsertModelAnnotations3 0, 327663, True, True, False, False

swDrawing.SaveAs2 curfilename, 0, False, False

End Sub

SolidworksApi/macros