Sub T_4()
Dim Doc As Document
Pfad = "c:\users\xxx\desktop\"
f = Dir(Pfad & "*.doc?")
Do While f <> ""
Debug.Print f
Set Doc = Documents.Open(Pfad & f)
If Doc.CustomDocumentProperties.Count > 0 Then
If Not Doc.CustomDocumentProperties("Punt") Is Nothing Then
Debug.Print Doc.CustomDocumentProperties("Punt").Value
Open Pfad & "log.txt" For Append As #1
Print #1, Pfad & f
Close #1
End If
End If
Doc.Close 0
f = Dir
Loop
End Sub