|
Hallo liebe Leser,
ich habe die Aufgabe ein VBA Skript zu schreiben, welches einen spezifischen Pfad durchläuft und alle Word Dokumente auf spezifische eigen eingefügte "Benutzerdefiniterte Eigenschaftsfelder" zu filtern und diese dann anschließend in eine Log Datei notieren und löschen.
Ich habe bereits folgenden Code zusammen geschuster, aber das läuft bei mir leider vor und hinten nicht. Vor allem habe ich ein Problem mit dem Auslesen der benutzerdefiniteren Eigenschaftsfelder. Die "normalen" Felder wie Kategorie Name Titel etc.. kriege ich ausgelesen, aber spezifische aus dem "Panel Anpassen" unten im Eigenschaften bei Word leider nicht. Dort liegt z.b eine Eigenschaft "PUNT" diese kann ich nicht auslesen.
Option Explicit
Sub main()
LoopThroughFolder "C:\tmp\", Split(".docx", ",") 'such in C:\YourFolder nach xls, xlsx oder xlsm
End Sub
Public Sub LoopThroughFolder(path As String, Filter As Variant)
Dim fso, oFolder, oSubFolder, oFile, queue As Collection
On Error Resume Next 'Falls Permission denied nächsten Folder/File nehmen (quick n dirty)
Set fso = CreateObject("Scripting.FileSystemObject")
Set queue = New Collection
queue.Add fso.GetFolder(path)
Dim counter As Integer
counter = 0
Dim feld() As Collection
Do While queue.Count > 0
Set oFolder = queue(1)
queue.Remove 1
For Each oSubFolder In oFolder.SubFolders
If oSubFolder <> vbEmpty Then queue.Add oSubFolder
Next
For Each oFile In oFolder.Files
If oFile <> vbEmpty Then
If IsInArray(fso.GetExtensionName(oFile.path), Filter) Then
'Debug.Print oFile.path & " Gefunden" 'mach was mit der Datei
'Dim AppWD As Object
'Set AppWD = CreateObject("Word.Application") 'Word als Object starten
'AppWD.Visible = False
'AppWD.Documents.Open oFile.path, ReadOnly:=False
'Set Eigenschaft = ActiveDocument.BuiltInDocumentProperties
'Debug.Print Eigenschaft.LinkToContent
'AppWD.Quit
End If
End If
Next
Loop
End Sub
Function IsInArray(str As String, arr As Variant) As Boolean
IsInArray = (UBound(Filter(arr, str)) > -1)
End Function
|