|  
                                             
	So sollte es auch für die Unterordner klappen: 
Sub Final()
'alle Pfad + Dateinamen per Powershell und copy/paste in dieses Document bringen
Const Pfad As String = "c:\users\xxx\desktop\" ' <<< anpassen >>>
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
                'kill Pfad & f ' löschen, erst nach Prüfung aktivieren
                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
	  
	T_1 und T_2 sind nur "Helfer" um CustomProperties anzulegen bzw auszulesen. 
	  
     |