Hi I need a litle help for my macro. 

1. First I want to open part from active drawing.

this is my macro that doesn't work :S

Dim swApp As Object
Dim sFileName As String
Dim Drw As Object

Sub main()
Set swApp = Application.SldWorks
Set Drw = swApp.ActiveDoc

Set fso = CreateObject("Scripting.FileSystemObject")
sFileName = Left\\\$(Drw.GetPathName, (Len(Drw.GetPathName) - 6)) & "SLDPRT"
If fso.FileExists(sFileName) Then
    Set Part = swApp.OpenDoc(sFileName, swDocPART)
    Else: MsgBox ("Part does not exist")
End If

End Sub

2. I want to fill configuration costume properties from exel detabase. 

I would like the macro  find in Excel the corresponding properties (Description, PART NUMBER ...) according to the file name (name of part). However, they must be entered at the configuration level (cofiguration specific).  

like:

\\\$PRPSHEET:{Description} for Description

This is the code that works for me. but I don't know how I need to fix it to make it work at the configuration level

Dim swApp As SldWorks.SldWorks
Dim excApp As Excel.Application
Dim swModel As SldWorks.ModelDoc2
Dim swCustPrpMgr As config.CustomPropertyManager
Dim PARTNUMBER As Object

Sub main()

Set swApp = Application.SldWorks

Set swApp = Application.SldWorks
Set excApp = GetObject(, "Excel.Application")

Set swModel = swApp.ActiveDoc

Set swCustPrpMgr = swModel.Extension.CustomPropertyManager("")

Dim excRange As range
Dim excSheet As Excel.Worksheet
Set excSheet = excApp.ActiveSheet
Set excRange = excSheet.range(excApp.Cells(1, 1), excApp.Cells(1000, 1))

Dim searchRes As range

Dim name As String

Dim index As Integer

Dim title As String

title = swModel.GetTitle()

index = InStr(title, ".")

name = Left(title, Len(title) - IIf(index = 0, 0, index + 1))

Set searchRes = excRange.Cells.Find(name)

If Not searchRes Is Nothing Then

LinkPrpToCell searchRes.row, 1, "Item No"
LinkPrpToCell searchRes.row, 2, "PART NUMBER"
LinkPrpToCell searchRes.row, 3, "Description"
LinkPrpToCell searchRes.row, 4, "SAP Number"

End If

End Sub

Sub LinkPrpToCell(row As Integer, col As Integer, prpName As String)

Dim value As String
Dim field As String

field = prpName
value = excApp.Cells(row, col).value

swCustPrpMgr.Add2 field, swCustomInfoType_e.swCustomInfoText, value
swCustPrpMgr.Set field, value

End Sub

Excel, test parts, macro..... everything is attached in "macro.rar"

Some code is based on already written macros from Deepak Gupta. I hope he doesn't mind.

thanks