Lee,
Here is some code I think you will find useful. It is something I once found and edited a bit for your purpose. You will find it need some tweaking, but basically it does the job. It reads from the enclosed xls file.
Let me know if it works.
Mattijs van Lunsen
Tebulo Engeneering, Holland
Option Explicit
Public Sub CopyProperty()
' Leg een verbinding met het Inventor document
Dim oDoc As Document
Set oDoc = ThisApplication.ActiveDocument
' Open the proper Excel file
Dim oXls As Excel.Application
Set oXls = CreateObject("Excel.Application")
Dim oSheet As Excel.WorkSheet
Set oSheet = oXls.Workbooks.Open("D:\MDT5 Properties.xls").ActiveSheet
' Using the Inventor document name as a reference
Dim sPath As String
Dim oRow As Integer
Dim oColumn As Integer
oRow = 1
oColumn = 1
sPath = Left(oDoc.DisplayName, Len(oDoc.DisplayName) - 4)
Do While Not oSheet.Cells(oRow, 1) = sPath
oRow = oRow + 1
Loop
Dim sProperty As String
Dim sValue As String
Do While Not oSheet.Cells(1, oColumn) = ""
On Error Resume Next
sProperty = oSheet.Cells(1, oColumn)
sValue = oSheet.Cells(oRow, oColumn)
' Next line will crash if property already excists, solved by error trapping
Call oDoc.PropertySets("User Defined Properties").Add(sValue, sProperty)
If Err 0 Then
Err.Clear
oDoc.PropertySets("User Defined Properties").Item(sProperty).Delete
Call oDoc.PropertySets("User Defined Properties").Add(sValue, sProperty)
End If
oColumn = oColumn + 1
Loop
' Do not remove, if not present Excel will still be running
oXls.Quit
Set oSheet = Nothing
Set oXls = Nothing
End Sub
