This example shows how to traverse an assembly at the component level. It is assumed that you have an active assembly.

2010 SOLIDWORKS API Help - Traverse Assembly at Component Level Example (VBA)

http://help.solidworks.com/2010/english/api/sldworksapi/traverse_assembly_at_component_level_example_vb.htm

I use other method,  see follow code.

Function TraverseComponentArr(SwAssy As AssemblyDoc)

   Dim oDict As New Dictionary

   Dim vComp, swComp As Component2, oSwModel As ModelDoc2

      vComp = SwAssy.GetComponents(True)

      For ii = 0 To UBound(vComp)

          Set swComp = vComp(ii)

          Set oDict(swComp.GetPathName) = swComp

      Next ii

      TraverseComponentArr = oDict.Items

End Function

Private Sub ll()

   Dim swApp As SldWorks.SldWorks, swModel As ModelDoc2

       Set swApp = Application.SldWorks

       Set swModel = swApp.ActiveDoc

   Dim SwAssy As AssemblyDoc, CompArr, CompArr1

       CompArr = TraverseComponentArr(swModel)

   Dim swComp As Component2, oSwModel As ModelDoc2

       For ii = 0 To UBound(CompArr)

          Set swComp = CompArr(ii)

          Debug.Print swComp.GetPathName, swComp.ReferencedConfiguration

          If UCase(swComp.GetPathName) Like "*SLDASM" Then

              swComp.SetSuppression2 swComponentResolved

              Set oSwModel = swComp.GetModelDoc

              'Stop

              CompArr1 = TraverseComponentArr(oSwModel)

              For jj = 0 To UBound(CompArr1)

                  Set swComp = CompArr1(jj)

                  Set oSwModel = swComp.GetModelDoc

                  'Stop

                  Debug.Print swComp.Name2, swComp.ReferencedConfiguration

                  'SwComp.GetPathName '.GetModelDoc.GetTitle

              Next jj

          End If

       Next ii

End Sub

*********************************

Function TraverseComponentArr(SwAssy As AssemblyDoc)

   Dim oDict As New Dictionary

   Dim vComp, SwComp As Component2, oSwModel As ModelDoc2

      vComp = SwAssy.GetComponents(True)

      For ii = 0 To UBound(vComp)

          Set SwComp = vComp(ii)

          Set oDict(SwComp.GetPathName) = SwComp

      Next ii

      TraverseComponentArr = oDict.Items

End Function

Function retuSheetArr(SwAssy As AssemblyDoc, SheetArr)

   Dim CompArr, CompArr1, Str

       CompArr = TraverseComponentArr(SwAssy)

   Dim rSheetArr()

       ReDim rSheetArr(UBound(SheetArr) - 1, 1)

   Dim SwComp As Component2, oSwModel As ModelDoc2

       For ii = 0 To UBound(CompArr)

          Set SwComp = CompArr(ii)

          Debug.Print SwComp.Name, , , SwComp.ReferencedConfiguration

          Str = SwComp.Name

          Str = Split(Str, "-")(0)

          For jj = 0 To UBound(SheetArr)

              If SheetArr(jj) = Str Then

                  rSheetArr(jj - 1, 0) = Str

                  rSheetArr(jj - 1, 1) = SwComp.ReferencedConfiguration

                  Exit For

              End If

          Next jj

          ''

          If UCase(SwComp.GetPathName) Like "*SLDASM" Then

              ''

              SwComp.SetSuppression2 swComponentResolved

              Set oSwModel = SwComp.GetModelDoc

              oSwModel.ShowConfiguration2 SwComp.ReferencedConfiguration

              oSwModel.ForceRebuild3 False

              'Debug.Print oSwModel.GetPathName

              'Stop

              '

              CompArr1 = TraverseComponentArr(oSwModel)

              For jj = 0 To UBound(CompArr1)

                  Set SwComp = CompArr1(jj)

                  Set oSwModel = SwComp.GetModelDoc

                  Debug.Print SwComp.Name, , , SwComp.ReferencedConfiguration

                  Str = SwComp.Name

                  Str = Split(Str, "-")(0)

                  ''

                  For jj1 = 0 To UBound(SheetArr)

                     If SheetArr(jj1) = Str Then

                        rSheetArr(jj1 - 1, 0) = Str

                        rSheetArr(jj1 - 1, 1) = SwComp.ReferencedConfiguration

                        Exit For

                     End If

                  Next jj1

                  ''

              Next jj

          End If

       Next ii

       ''

       retuSheetArr = rSheetArr

End Function

Private Sub ChangViewConfiguration()

    Dim Xls As Excel.Application, Rng As Range

        Set Xls = GetObject(, "Excel.Application")

        Set Rng = Xls.Selection

    Dim Sht As Worksheet

        Set Sht = Rng.Parent

    Dim PdfDwgPath, SldDrwPath, xlsPath, openSldDrw, saveSldDrw

        xlsPath = Xls.ActiveWorkbook.Path '& "\"

        Debug.Print Sht.Name

        PdfDwgPath = xlsPath & Sht.Cells(3, 1)

        SldDrwPath = xlsPath & Sht.Cells(3, 2)

        openSldDrw = SldDrwPath & Sht.Cells(4, 2)

        'Stop

    Dim SwApp As SldWorks.SldWorks, SwModel As ModelDoc2

        Set SwApp = Application.SldWorks

        Set SwModel = SwApp.ActiveDoc

    Dim SwSelMgr As SelectionMgr

        Set SwSelMgr = SwModel.SelectionManager

    Dim SwDraw As DrawingDoc

        Set SwDraw = SwModel

    Dim vSheet, SwSheet As Sheet

        vSheet = SwDraw.GetSheetNames

        SwDraw.ActivateSheet (vSheet(0))

    Dim SwView As View

    Dim SwAssy As AssemblyDoc

    Dim SwSheetArr, SheetArr

        SheetArr = SwDraw.GetSheetNames

    Dim CompArr, SwComp As Component2

        For ii = 1 To Rng.Rows.Count

           Set SwView = SwDraw.GetFirstView

           Set SwView = SwView.GetNextView

           SwView.ReferencedConfiguration = Rng(ii, 1)

           ''

           Set SwModel = SwView.ReferencedDocument

           ''

           SwModel.ForceRebuild3 True

           SwModel.ShowConfiguration Rng(ii, 1)

           ''

           SwModel.ForceRebuild3 False

           Set SwAssy = SwModel

           SwSheetArr = retuSheetArr(SwAssy, SheetArr)

           Str = SwAssy.GetTitle

           SwSheetArr(0, 0) = Left(Str, Len(Str) - 7)

           SwSheetArr(0, 1) = Rng(ii, 1)

           ''

           For jj = 0 To UBound(SwSheetArr)

               Debug.Print jj, SwSheetArr(jj, 0),

               Debug.Print SwSheetArr(jj, 1)

           Next jj

           ''

           ''

        Next ii

End Sub