Hi,
Damit ich nicht für alles neu nachdenken muß habe ich mir da zwei Sub's gebastelt, die das Lesen und Schreiben übernehmen.
HTH
Sub Property_setzen(oDoc As Document, sPropName As String, vPropValue As Variant)
' Belegt eine Property mit einem Wert.
' Ist die Property nicht vorhanden, so wird sie angelegt.
' Obtain the PropertySets collection object
Dim oPropSets As PropertySets
Set oPropSets = oDoc.PropertySets
Dim bPropertyDa As Boolean
Dim oProp As Property
bPropertyDa = False
' Iterate through all the PropertySets one by one using for loop
' and changing its value if found
Dim oPropSet As PropertySet
For Each oPropSet In oPropSets
For Each oProp In oPropSet
'Debug.Print oProp.Name
If oProp.Name = sPropName Then
oProp.Value = vPropValue
bPropertyDa = True
Exit For
End If
Next
Next
'Property anlegen und Wert eintragen
If Not bPropertyDa Then
'oDoc.PropertySets("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}").Add vPropValue, sPropName
oDoc.PropertySets.Item("User Defined Properties").Add vPropValue, sPropName
End If
End Sub
'--------------------------------------------------------------------------------------------------
Public Function Property_lesen(oDoc As Document, sPropName As String) As Variant
' Liest eine Property.
' Ist die Property nicht vorhanden, so wird "" zurückgegeben.
Property_lesen = ""
' Obtain the PropertySets collection object
Dim oPropSets As PropertySets
Set oPropSets = oDoc.PropertySets
Dim oProp As Property
' Iterate through all the PropertySets one by one using for loop
Dim oPropSet As PropertySet
For Each oPropSet In oPropSets
For Each oProp In oPropSet
'Debug.Print oProp.Name
If oProp.Name = sPropName Then
Property_lesen = oProp.Value
Exit For
End If
Next
Next
End Function
------------------
Gruß Lothar
---------------------------------------------------
Während man es aufschiebt, verrinnt das Leben.
—Lucius Annaeus Seneca (ca. 4 v. Chr - 65 n. Chr.)
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP
Foren auf CAD.de (alle Foren)
| 
