Hi all,  I'm trying to create an XML file from a BOM on a drawing.  But there is a little catch to it.  The drawing may have several BOM in it and none have the correct columns for what I need.  So I've been piecing together code, some from the SW website, some from other resources on the web and some I wrote.  in the code that I have I insert the correct BOM and then "search" the tree for the last BOM.  From there it does create the XML file with everything configured correctly except that it is grabbing all the BOM's not just the one which I have the name of.  Any help to narrow this down would be greatly appreciated.

PS I have no problem to put the actual macro up here if it helps.

Thanks,

'-------------------------------------------------------------

Option Explicit

Public Enum swTableSplitDirection_e

    swTableSplit_None = 0

    swTableSplit_Horizontal = 1

    swTableSplit_Vertical = 2

End Enum

Sub ProcessTableAnn _

( _

    swApp As SldWorks.SldWorks, _

    swModel As SldWorks.ModelDoc2, _

    swTableAnn As SldWorks.TableAnnotation, _

    XMLfile As Scripting.TextStream _

)

    Dim nNumRow                 As Long

    Dim nNumCol                 As Long

    Dim nNumHeader              As Long

    Dim sHeaderText()           As String

    Dim i                       As Long

    Dim j                       As Long

    Dim k                       As Long  

    Dim nIndex                  As Long

    Dim nCount                  As Long

    Dim nStart                  As Long

    Dim nEnd                    As Long

    Dim nSplitDir               As Long

    nNumHeader = swTableAnn.GetHeaderCount: Debug.Assert nNumHeader >= 1

    nSplitDir = swTableAnn.GetSplitInformation(nIndex, nCount, nStart, nEnd)

    If swTableSplit_None = nSplitDir Then

        Debug.Assert 0 = nIndex

        Debug.Assert 0 = nCount

        Debug.Assert 0 = nStart

        Debug.Assert 0 = nEnd

        nNumRow = swTableAnn.RowCount

        nNumCol = swTableAnn.ColumnCount

        nStart = nNumHeader

        nEnd = nNumRow - 1

    Else

        Debug.Assert swTableSplit_Horizontal = nSplitDir

        Debug.Assert nIndex >= 0

        Debug.Assert nCount >= 0

        Debug.Assert nStart >= 0

        Debug.Assert nEnd >= nStart

        nNumCol = swTableAnn.ColumnCount

        If 1 = nIndex Then

            ' Add header offset for first portion of table

            nStart = nStart + nNumHeader

        End If

    End If

    If swTableAnn.TitleVisible Then

        XMLfile.WriteLine "                "

    End If

    ReDim sHeaderText(nNumCol - 1)

    For j = 0 To nNumCol - 1

        sHeaderText(j) = swTableAnn.GetColumnTitle(j)

       ' Replace invalid characters for XML tags

        sHeaderText(j) = Replace(sHeaderText(j), ".", "")

        sHeaderText(j) = Replace(sHeaderText(j), " ", "_")

    Next 

    For j = nStart To nEnd

        XMLfile.WriteLine "                "

        For k = 0 To nNumCol - 1

            XMLfile.WriteLine "                    " + _

                "<" + sHeaderText(k) + ">" + _

                    swTableAnn.Text(j, k) + _

                ""

        Next k

        XMLfile.WriteLine "                "

    Next j

End Sub

Sub ProcessBomFeature _

( _

    swApp As SldWorks.SldWorks, _

    swModel As SldWorks.ModelDoc2, _

    swBomFeat As SldWorks.BomFeature, _

    XMLfile As Scripting.TextStream _

)

    Dim swFeat                  As SldWorks.Feature

    Dim vTableArr               As Variant

    Dim vTable                  As Variant

    Dim swTable                 As SldWorks.TableAnnotation

Set swFeat = swBomFeat.GetFeature

    XMLfile.WriteLine "        "

    vTableArr = swBomFeat.GetTableAnnotations

    For Each vTable In vTableArr

        Set swTable = vTable

        ProcessTableAnn swApp, swModel, swTable, XMLfile

    Next vTable

    XMLfile.WriteLine "        "

End Sub

Sub main()

    Dim swApp                   As SldWorks.SldWorks

    Dim swModel                 As SldWorks.ModelDoc2

    Dim swDraw                  As SldWorks.DrawingDoc

    Dim swSheet                 As SldWorks.Sheet

    Dim swFeat                  As SldWorks.Feature

    Dim swBomFeat               As SldWorks.BomFeature

    Dim sPathName               As String

    Dim nNumSheet               As Long

    Dim nRetval                 As Long

    Dim i                       As Long

    Dim bIsFirstSheet           As Boolean

    Dim bRet                    As Boolean

    Dim fso                     As Scripting.FileSystemObject

    Dim XMLfile                 As Scripting.TextStream

    Set swApp = Application.SldWorks

    Set swModel = swApp.ActiveDoc

    Set swDraw = swModel

    bIsFirstSheet = True

'-----------------------------------------------------

' This section adds the BOM to the Drawing

'

Dim Part As Object

Dim boolstatus As Boolean

Dim longstatus As Long, longwarnings As Long

Set swApp = Application.SldWorks

Set Part = swApp.ActiveDoc

boolstatus = Part.ActivateView("Drawing View1")

boolstatus = Part.Extension.SelectByID2("Drawing View1", "DRAWINGVIEW", 0.03907265301171, 0.269313374338, 0, False, 0, Nothing, 0)

boolstatus = Part.Extension.SelectByID2("Drawing View1", "DRAWINGVIEW", 0.07054146514819, 0.2598727306971, 0, False, 0, Nothing, 0)

Part.ClearSelection2 True

Dim swActiveView As Object

Set swActiveView = Part.ActiveDrawingView

Dim swBOMTable As Object

Set swBOMTable = swActiveView.InsertBomTable2(False, 0.03515977505523, 0.3102228301154, swBOMConfigurationAnchorType_e.swBOMConfigurationAnchor_TopLeft, swBomType_e.swBomType_PartsOnly, "XA67607Q (dia 1.75)(bul 05)", "C:\Documents and Settings\Tom\My Documents\Dropbox\ACS\RHF\VMTEMP\XML to VM-BOM.sldbomtbt")

'

' Done adding the BOM

'------------------------------------------------------

'

' This is getting the feature name, extracting BOM

'

    Dim BomName As String

    Set swApp = Application.SldWorks

    Set swModel = swApp.ActiveDoc

    Set swDraw = swModel

    Set swFeat = swModel.FirstFeature

    Do While Not swFeat Is Nothing

        If "BomFeat" = swFeat.GetTypeName Then

            Debug.Print "******************************"

            Debug.Print "Feature Name : " & swFeat.Name

            Set swBomFeat = swFeat.GetSpecificFeature2

            BomName = swFeat.Name

        End If

        Set swFeat = swFeat.GetNextFeature

        If swFeat Is Nothing Then

            GoTo Line2000

        End If

    Loop

Line2000:

MsgBox BomName 'verify that I have the correct BOM

'

' Done getting the BOM name

'

'-----------------------------------------------------

    ' Strip off SolidWorks file extension (sldxxx)

    ' and add XML extension (xml)

    sPathName = swModel.GetPathName

    sPathName = Left(sPathName, Len(sPathName) - 6)

    sPathName = sPathName + "xml"

    Set fso = CreateObject("Scripting.FileSystemObject")

    Set XMLfile = fso.CreateTextFile(sPathName, True)

'

'-----------------------------------------------------

'   Visual Manufacturing Header Text

    XMLfile.WriteLine "LSAXML"

    XMLfile.WriteBlankLines (1)

    XMLfile.WriteLine ""

    Set swFeat = swModel.FirstFeature

    Do While Not swFeat Is Nothing

        If "BomFeat" = swFeat.GetTypeName Then

            Set swBomFeat = swFeat.GetSpecificFeature2

            ProcessBomFeature swApp, swModel, swBomFeat, XMLfile

        End If

        Set swFeat = swFeat.GetNextFeature

'

    Loop

'

    XMLfile.WriteLine ""

    XMLfile.Close

End Sub