SolidWorks*Excel+VBA-材质?不,这是灵魂

Sub SetMats() '设置材质Dim swApp As SldWorks.SldWorks, FullModelPath As StringDim OpennedModel As ModelDoc2, PartModel As PartDoc, k As Integer, posn As Long, SwErr As LongDim MatsDb As String'On Error Resume Next    Set swApp = GetObject(, "SldWorks.Application")    If swApp Is Nothing Then        MsgBox "请先打开SolidWorks！", vbExclamation, "不正经的机械仙人"        Exit Sub    End If    MatsDb = ThisWorkbook.Sheets("SW0 参数设置").Range("C2").Value    With ThisWorkbook.ActiveSheet        If myselcondi Then            swApp.CloseAllDocuments (True)            For k = 1 To Selnumber                ProcessBarUpdater k, Selnumber, "正在设置材质：", "共" & Selnumber & "个，第" & k & "个 ..."                posn = Selarray(k)                FullModelPath = .Cells(posn, 2) & "\" & .Cells(posn, 3) & .Cells(posn, 4)                If UCase(.Cells(posn, 4)) = ".SLDPRT" Then                    Set OpennedModel = swApp.OpenDoc2(FullModelPath, swDocPART, False, False, True, SwErr)                    If OpennedModel Is Nothing Then                        .Cells(posn, 1) = "设置失败！"                    Else                        Set PartModel = OpennedModel                        PartModel.SetMaterialPropertyName2 "", MatsDb, .Cells(posn, 11)                        If PartModel.GetMaterialPropertyName2("", "") <> .Cells(posn, 11) Then                            .Cells(posn, 1) = "设置失败！"                        Else                            PartModel.GraphicsRedraw2                            .Cells(posn, 1) = "已设置材质"                        End If                        Set PartModel = Nothing                    End If                Else                    Set OpennedModel = swApp.OpenDoc2(FullModelPath, swDocASSEMBLY, False, False, True, SwErr)                    If OpennedModel Is Nothing Then                        .Cells(posn, 1) = "设置失败！"                    Else                        OpennedModel.Extension.CustomPropertyManager("").Add3 "材料", swCustomInfoText, .Cells(posn, 11), swCustomPropertyReplaceValue                        .Cells(posn, 1) = "装配，定制属性"                    End If                End If                If Not OpennedModel Is Nothing Then                    OpennedModel.Save2 True: swApp.QuitDoc FullModelPath                    Set OpennedModel = Nothing                End If            Next        Else            MsgBox "未选择正确行，程序结束！", vbExclamation, "不正经的机械仙人"        End If    End With    Err.Clear    Application.StatusBar = FalseEnd Sub