尺寸驱动模型，写个通用的VBA代码，哪位大神能指导下？

做个通用的VBA代码，要实现以下功能：打开已有的一个部件或零件，通过VBA提取部件及其零件中所有的特征与草图所包含的尺寸名称与尺寸数值大小，导入到excel，再在excel中修改相应的尺寸数值，来驱动模型使之更新。
自己查的资料附上，只能读出零件的尺寸，并写入excel。

Function SetSwPart()
  Dim SwApp As Object
  Dim SelMgr As Object, boolStatus As Boolean
  Dim longstatus As Long, longwarnings As Long
  
  Set SwApp = GetObject(, "sldworks.application")
  
  Set SetSwPart = SwApp.ActiveDoc
  
End Function
''****************************

Private Sub ReadSwDimensionInSldPrt()
  ''读SW的变量数据
  Dim oDic
  Set oDic = CreateObject("Scripting.Dictionary")
   
  
  nn = Range("A65536").End(3).Row
  Set Rng = Range("A1:Z" & nn)
  
    Dim swFeat As Object, swSubFeat As Object
    Dim swDispDim As Object, SwDim As Object
    Dim swAnn As Object
    Dim bRet As Boolean
    Dim Str
   
    Set SwApp = CreateObject("SldWorks.Application")
    Set SwPart = SetSwPart
    Set swFeat = SwPart.FirstFeature
   
   
    kk = 1
    Do While Not swFeat Is Nothing
        Debug.Print "  " + swFeat.Name
        Set swSubFeat = swFeat.GetFirstSubFeature
        Do While Not swSubFeat Is Nothing
            Debug.Print "      " + swSubFeat.Name
            
            Set swDispDim = swSubFeat.GetFirstDisplayDimension
            Do While Not swDispDim Is Nothing
                Set swAnn = swDispDim.GetAnnotation
                Set SwDim = swDispDim.GetDimension
                Debug.Print "          [" & SwDim.FullName & "] = " & SwDim.GetSystemValue2("")
                'Debug.Print swDim.FullName, swDim.GetSystemValue2("")
                Set swDispDim = swSubFeat.GetNextDisplayDimension(swDispDim)
            Loop
            Set swSubFeat = swSubFeat.GetNextSubFeature
        Loop
        
        Set swDispDim = swFeat.GetFirstDisplayDimension
        Do While Not swDispDim Is Nothing
            Set swAnn = swDispDim.GetAnnotation
            Set SwDim = swDispDim.GetDimension
            
            Debug.Print "    [" & SwDim.FullName & "] = " & SwDim.GetSystemValue2("")
            Debug.Print SwDim.FullName, SwDim.GetSystemValue2("")
            Str = SwDim.FullName
            oArr = Split(Str, "@")
            Str = oArr(0) & "@" & oArr(1)
            '
            Cells(kk, 5) = SwDim.GetSystemValue2("")
            Cells(kk, 4) = oArr(1)
            Debug.Print SwDim.GetSystemValue2("")
            oDic(Str) = SwDim.GetSystemValue2("")
            
            Set swDispDim = swFeat.GetNextDisplayDimension(swDispDim)
            kk = kk + 1
        Loop
        Set swFeat = swFeat.GetNextFeature
    Loop
    Dim oArr1, oArr2, cc
    cc = 6
    oArr1 = oDic.keys: oArr2 = oDic.items
    For kk = 1 To UBound(oArr1) + 1
        Cells(kk, 1 + cc) = kk - 1
        Cells(kk, 2 + cc) = "=" & """Arr(""" & " & " & Cells(kk, 1 + cc).Address(0, 0) & " & " & """)="""
        Cells(kk, 3 + cc) = "'" & Chr(34) & oArr1(kk - 1) & Chr(34)
        Cells(kk, 4 + cc) = Split(oArr1(kk - 1), "@")(1)
        Cells(kk, 5 + cc) = oArr2(kk - 1)
   
    Next kk
End Sub