AW: Wörter zählen
08.10.2011 11:16:02
ing.grohn
Hallo Nepumuk,
habs jetzt so gelöst:
Public Sub Test()
Const FOLDER_PATH = "c:\albrecht"
Dim objShell As Object, objFolder As Object
Dim lngIndex As Long, lngItemIndex As Long, lngRow As Long
Dim vntName As Variant
Application.ScreenUpdating = False
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(FOLDER_PATH)
For lngIndex = 0 To 255
If objFolder.GetDetailsOf(vntName, lngIndex) = "Wortanzahl" Then
lngItemIndex = lngIndex
MsgBox lngItemIndex
Exit For
End If
Next
If lngItemIndex > 0 Then
For Each vntName In objFolder.Items
MsgBox vntName
'If Left(vntName, 2) = "MS" Then
'If LCase$(Right$(vntName, 4)) = ".doc" Or LCase$(Right$(vntName, 5)) Like ".docx" _
Then
If LCase$(Right(objFolder.GetDetailsOf(vntName, 179), 4)) = ".doc" _
Or LCase$(Right(objFolder.GetDetailsOf(vntName, 179), 5)) Like ".doc*" Then
lngRow = lngRow + 1
Cells(lngRow, 1).Value = vntName
Cells(lngRow, 2).Value = objFolder.GetDetailsOf(vntName, lngItemIndex)
Cells(lngRow, 3).Value = objFolder.GetDetailsOf(vntName, 179)
End If
Next
Else
MsgBox "Eigenschaft nicht gefunden."
End If
Set objShell = Nothing
Set objFolder = Nothing
Application.ScreenUpdating = True
End Sub
(vielleicht gehts eleganter?)
mal schaun, ob das auch bei xp passt.
Ich wünsche ein schönes Wochenende und vielen Dank für die Hilfe
Mit freundlichen Grüßen
Albrecht