Sub Final()
Const Pfad As String = "c:\users\xxx\desktop\"
Dim Doc As Document
With ActiveDocument
For i = 1 To .Paragraphs.Count
f = .Paragraphs(i).Range.Text
f = Left(f, Len(f) - 1)
Set Doc = Documents.Open(f, , 1)
If Doc.CustomDocumentProperties.Count > 0 Then
If Not Doc.CustomDocumentProperties("Punt") Is Nothing Then
Debug.Print Doc.CustomDocumentProperties("Punt").Value
If Doc.CustomDocumentProperties("Punt").Value = "Punt" Then
Open Pfad & "log.txt" For Append As #1
Print #1, f
Close #1
End If
End If
End If
Doc.Close 0
Next i
End With
End Sub
=============================================================
Sub T_1()
Dim CProps As DocumentProperties
Dim CProp As DocumentProperty
With ActiveDocument
Set CProps = .CustomDocumentProperties
Set CProp = CProps.Add("Punt", False, msoPropertyTypeString, "Punt")
End With
End Sub
--------------------------------------
Sub T_2()
Dim p As DocumentProperty
For Each p In ActiveDocument.CustomDocumentProperties
Debug.Print p.Name, p.Value
Next p
End Sub