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.
|