Document.Properties

Forumthread: Document.Properties

Document.Properties

17.03.2004 17:53:25

Alexander

Hallo Forum,
Ich möchte gerne eine Liste an Dateien über eine Excel Applikation auslesen und anschließend das letzte Veränderungsdatum, sowie den Autor des Dokuments ausgeben lassen. Dazu verwende ich folgenden Code:


Sub Schaltfläche1_BeiKlick()
Set fs = Application.FileSearch
Set fo = CreateObject("Scripting.FileSystemObject")
With fs
.LookIn = "C:\Verzeichnis"
.SearchSubFolders = True
.Filename = "*.*"
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
Set f = fo.GetFile(.FoundFiles(i))
Worksheets("Tabelle1").Cells(5 + i, 1).Value = f.Name
Worksheets("Tabelle1").Cells(5 + i, 2).Value = f.DateLastModified
Worksheets("Tabelle1").Cells(5 + i, 3).Value = f.BuiltinDocumentProperties(3)
Next i
Else
MsgBox "There were no files found."
End If
End With
End Sub

Beim Attribut BuiltinDocumentProperties gibt es Probleme. Wie kann ich mir die gewünschte Information ziehen, selbst wenn es sich nicht nur um MS-Dateien (doc, xls, ppt) handelt sondern z.B. auch pdf, htm...etc. Bitte möglichst mit Beispielcode.
Danke vorab.
Gruß aus Heidelberg
Alexander

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

AW: Document.Properties

17.03.2004 18:46:15

andre

AW: Document.Properties

17.03.2004 18:46:15

andre

hallo alexander,
wenn du dir die dateieigenschaften anschaust wirst du feststellen, dass die hier anders aussehen als bei den xls. manchmal sind weitere nicht dabei, und wenn sind's vielleicht andere. schaue dir mal den code an:

Sub ExtendedInfos()
   Dim objShell As Object
   Dim objFolder As Object
   Dim iCounter As Integer, iRow As Integer, iCol As Integer
   Dim strFileName As Variant
   Dim arrHeaders(34)
   Dim FileName As Variant, iFil As Long, Verz$
   On Error GoTo Fehler
   FileName = Application.GetOpenFilename("PDF-Files (*.PDF), *.PDF", 1, "DateiInfo", "Infos", True)
   If Not (IsArray(FileName)) Then Exit Sub
   Application.Calculation = xlCalculationManual
   Application.EnableEvents = False
   Application.ScreenUpdating = False
   Cells.ClearContents
   Verz = CurDir()
   If Right(Verz, 1) <> "\" Then Verz = Verz & "\"
   Set objShell = CreateObject("Shell.Application")
   Set objFolder = objShell.Namespace(UCase(Verz))
   For iCounter = 0 To 33
      arrHeaders(iCounter) = _
         objFolder.getdetailsof(strFileName, iCounter)
      Cells(1, iCounter + 1) = arrHeaders(iCounter)
   Next iCounter
   For iFil = LBound(FileName) To UBound(FileName)
       FileName(iFil) = Mid(FileName(iFil), Len(Verz) + 1)
   Next
   iRow = 2
   For Each strFileName In objFolder.items
       For iFil = LBound(FileName) To UBound(FileName)
           If (StrComp(strFileName.Name, Left(FileName(iFil), Len(FileName(iFil)) - 4), vbTextCompare) = 0) Then
              For iCounter = 0 To 33
                  Cells(iRow, iCounter + 1).Value = iCounter + 1
                  Cells(iRow, iCounter + 1).Value = arrHeaders(iCounter)
                  Cells(iRow, iCounter + 1).Value = objFolder.getdetailsof(strFileName, iCounter)
              Next iCounter
              iRow = iRow + 1
              Exit For
           End If
       Next iFil
   Next strFileName
   GoTo Ende
Fehler:
   MsgBox Err.Description
Ende:
   Application.Calculation = xlCalculationAutomatic
   Application.EnableEvents = True
   Application.ScreenUpdating = True
End Sub

Code eingefügt mit Syntaxhighlighter 2.5

gruss andre

Beliebteste Forumthreads (12 Monate)

Forumthread: Document.Properties

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread