AW: Schlüsselwörter/Keywords aus Office 2007 auslesen
23.04.2009 09:54:52
Nepumuk
Hallo Matthias,
mit folgendem Beispiel kannst du alle Eigenschaften aller Dateien in einem Ordner auslesen:
Public Sub Dateieigenschaften()
'von K.Rola
Const STRFOLDER As String = "C:\Testordner\"
Dim objShell As Object, objFolder As Object
Dim intIndex As Integer, intColumn As Integer, lngRow As Long
Dim varName
If Dir(STRFOLDER, 16) = "" Then
MsgBox "Der Ordner " & STRFOLDER & " wurde nicht gefunden!", 64, "Hinweis"
Exit Sub
End If
Application.ScreenUpdating = False
Cells.Clear
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(STRFOLDER)
intColumn = 1
For intIndex = 0 To 300
Cells(1, intColumn + intIndex) = objFolder.GetDetailsOf(varName, intIndex)
Next
Rows(1).Font.Bold = True
lngRow = 2
For Each varName In objFolder.Items
For intIndex = 0 To 300
Cells(lngRow, intColumn + intIndex) = objFolder.GetDetailsOf(varName, intIndex)
Next
lngRow = lngRow + 1
Next
Columns.AutoFit
Application.ScreenUpdating = True
End Sub
Mit folgendem Beispiel eine bestimmte Eigenschaft einer Datei:
Public Sub Beispiel()
Const FILE_FOLDER = "C:\Testordner\"
Const FILE_PROPERTY = "Markierungen"
Const FILE_NAME = "Mappe1.xlsx"
Const MAX_PROPERTYS = 300
Dim objShell As Object, objFolder As Object
Dim lngIndex As Long, lngPosition As Long
' initialize errorhandler
On Error GoTo error_exit
' verify folder exit
If Dir$(FILE_FOLDER, vbDirectory) = "" Then _
Err.Raise Number:=vbObjectError, Description:= _
"Ordner ''" & FILE_FOLDER & "'' nicht gefunden."
' create object
Set objShell = CreateObject(Class:="Shell.Application")
' set reverence to folder
Set objFolder = objShell.Namespace((FILE_FOLDER))
' search position of fileproperty
For lngIndex = 0 To MAX_PROPERTYS
If Trim$(objFolder.GetDetailsOf("", lngIndex)) <> "" Then
If Cbool(InStr(FILE_PROPERTY, objFolder.GetDetailsOf("", lngIndex))) Then
lngPosition = lngIndex
Exit For
End If
End If
Next
' property not found - trigger an error
If lngPosition = 0 Then _
Err.Raise Number:=vbObjectError, Description:="Dateieigenschaft ''" & _
FILE_PROPERTY & "'' nicht gefunden."
' write filename and property to table
With Tabelle1
.Cells(1, 1).Value = FILE_NAME
.Cells(1, 2).Value = objFolder.GetDetailsOf( _
objFolder.ParseName(FILE_NAME), lngPosition)
End With
Tabelle1.Columns.AutoFit
sub_exit:
' clear objects
Set objShell = Nothing
Set objFolder = Nothing
Exit Sub
error_exit:
' show errormessage
MsgBox "Fehler: " & CStr(Err.Number) & vbLf & vbLf & _
Err.Description, vbCritical, "Fehler"
Resume sub_exit
End Sub
Aber, sobald eine Datei im Excel2007er Format (xlsx / xlsm) mit einem Lese- Schreibschutzkennwort versehen ist, kannst du sie nicht mehr auslesen.
Die Bezeichnungen in Excel, und im Explorer stimmen nicht überein. Du musst die Bezeichnungen benutzen, welche das 1. Beispiel in Zeile 1 schreibt. Und du kannst auch nicht nach der Position gehen, die ist nämlich von der Installation zusätzlicher Software, welche eigene Eigenschaften im Explorer einträgt, abhängig.
Gruß
Nepumuk