Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

Dateiinformationen auslesen und in Excel erfassen per VBA-Code

4,681 views
Skip to first unread message

Hermann Splitthoff

unread,
Aug 30, 2008, 12:21:46 PM8/30/08
to
Hallo liebe Leute,

mit dem weiter unten aufgeführten VBA-Code (hier aus der Newsgroup)
lese ich explizit Dateien bzw. deren Informationen auf einen Laufwerk
aus. Auf dem Laufwerk sind keine weiteren Pfade vorhanden. Diese
Informationen werden dann in einer Exceltabelle ausgegeben. Künftig
werden auch Unterordner auf dem Laufwerk vorhanden sein.

Wie ist dieser VBA-Code umzubauen, damit enthaltene Ordner (eine
Ebene) mit ausgelesen werden und wiederum in einer Exceltabelle – mit
Erweiterung der Ordnerangabe – ausgegeben werden? Ich bekomme den
Wechsel zwischen den Ordner nicht hin, ohne selber im VBA-Code
herumzufummeln. Das will ich eigentich vermeiden.

Hintergrund der Aktion ist, dass Sicherungsdateien auf einer
Festplatte (Laufwerk F:) kopiert werden und der Stand der Dateien
nachts als einfache DateiInformation gesichert werden sollen. Nun ist
die Anzahl der Dateien so groß geworden, dass je Jahr/Monat ein Ordner
(z.B. 2008_08) angelegt wird, so dass auf Laufwerk F: nur noch Pfade
liegen und darin die Dateien enthalten sind.

Bin für jede Hilfe dankbar.


Sub DateiInformationen_auslesen()
'
Dim Blatt As Worksheet
Dim Pfad As String
Dim DatNam As String
Dim i As Integer
'
Set Blatt = ThisWorkbook.Worksheets("Dateiinfos")
Pfad = "F:\"
DatNam = Dir(Pfad)
'
Sheets("Dateiinfos").Select
Range("A3:E10000").ClearContents
Range("A1").Select
'
With Blatt
.Cells(1, 1) = "Pfad:"
.Cells(1, 2) = Pfad
.Cells(2, 2) = "Name"
.Cells(2, 3) = "Datum"
.Cells(2, 4) = "Uhrzeit"
.Cells(2, 5) = "Größe"
.Cells(2, 6) = "Ordner" 'neue Spalte in Tabellenblatt
i = 3
'
Do While DatNam <> ""
.Cells(i, 2) = DatNam
.Cells(i, 3) = Int(FileDateTime(Pfad & DatNam))
.Cells(i, 4) = FileDateTime(Pfad & DatNam) -
Int(FileDateTime(Pfad & DatNam))
.Cells(i, 5) = FileLen(Pfad & DatNam)
'.Cells(i, 6) = 'neuer Eintrag zur Angabe des Ordners (?)
i = i + 1
DatNam = Dir
Loop
'
.Columns("C:C").NumberFormat = "DD.MM.YYYY"
.Columns("D:D").NumberFormat = "hh:mm:ss"
End With
'
End Sub

Schönen Gruß
Hermann

Peter Schleif

unread,
Aug 30, 2008, 1:44:34 PM8/30/08
to
Hermann Splitthoff schrieb am 30.08.2008 18:21 Uhr:
>
> Wie ist dieser VBA-Code umzubauen, damit enthaltene Ordner (eine
> Ebene) mit ausgelesen werden und wiederum in einer Exceltabelle – mit
> Erweiterung der Ordnerangabe – ausgegeben werden?

Hallo Hermann.

Das Durchwandern eines Ordners mir Dir() ist IMHO nicht mehr
zeitgemäß. Dafür gibt es Objekte mit extra dafür vorgesehenen
Eigenschaften und Methoden. Zum Beispiel hat das Folder-Object eine
Files-Auflistung und eine SubFolders-Auflistung die man bequem mit
For-Each durchlaufen kann. Siehe dazu auch die Links am Ende diese
Postings.

Peter


Sub DateiInformationen_auslesen_Peter()
Dim fso As Object
Dim ordner As Object
Dim subordner As Variant
Dim file As Variant
Dim i As Integer

Const PFAD = "F:\"

i = 3
Set fso = CreateObject("Scripting.FileSystemObject")
Set ordner = fso.GetFolder(PFAD)

With ThisWorkbook.Worksheets("Dateiinfos")
.[A1].Select
.[A3:F10000].ClearContents
.[A1:B1] = Array("Pfad:", PFAD)
.[B2:F2] = Array("Name","Datum","Uhrzeit","Größe","Ordner")
.[C:C].NumberFormat = "dd.mm.yyyy"
.[D:D].NumberFormat = "hh:mm:ss"
.[E:E].NumberFormat = "#,##0"

For Each file In ordner.Files
.Cells(i, 2) = file.Name
.Cells(i, 3) = DateValue(file.DateLastModified)
.Cells(i, 4) = TimeValue(file.DateLastModified)
.Cells(i, 5) = file.Size


i = i + 1

Next

For Each subordner In ordner.SubFolders
If (subordner.Attributes And 4) = 0 Then
For Each file In subordner.Files
.Cells(i, 2) = file.Name
.Cells(i, 3) = DateValue(file.DateLastModified)
.Cells(i, 4) = TimeValue(file.DateLastModified)
.Cells(i, 5) = file.Size
.Cells(i, 6) = subordner.Name


i = i + 1

Next
End If
Next

.[A:F].EntireColumn.AutoFit
End With
End Sub


Folder-Object:
http://msdn.microsoft.com/en-us/library/1c87day3(VS.85).aspx

File-Object
http://msdn.microsoft.com/en-us/library/1ft05taf(VS.85).aspx

Files-Auflistung:
http://msdn.microsoft.com/en-us/library/wz72a8c0(VS.85).aspx

SubFolders-Auflistung:
http://msdn.microsoft.com/en-us/library/e1dthkks(VS.85).aspx

Hermann Splitthoff

unread,
Aug 30, 2008, 2:29:43 PM8/30/08
to
On 30 Aug., 19:44, Peter Schleif <peter.schleif.s...@gmx.de> wrote:
> Hermann Splitthoff schrieb am 30.08.2008 18:21 Uhr:
>
>
>
> > Wie ist dieser VBA-Code umzubauen, damit enthaltene Ordner (eine
> > Ebene) mit ausgelesen werden und wiederum in einer Exceltabelle – mit
> > Erweiterung der Ordnerangabe – ausgegeben werden?
>
> Hallo Hermann.
>
> Das Durchwandern eines Ordners mir Dir() ist IMHO nicht mehr
> zeitgemäß. Dafür gibt es Objekte mit extra dafür vorgesehenen
> Eigenschaften und Methoden. Zum Beispiel hat das Folder-Object eine
> Files-Auflistung und eine SubFolders-Auflistung die man bequem mit
> For-Each durchlaufen kann. Siehe dazu auch die Links am Ende diese
> Postings.
>
> Peter

Hallo Peter,

vielen herzlichen Dank für die Hilfe. Es klappt gut!

Werde mich dann mal den moderneren Programmierabläufen widmen. :-)

Gruß Hermann

Peter Schleif

unread,
Aug 31, 2008, 5:59:39 AM8/31/08
to
Hermann Splitthoff schrieb am 30.08.2008 20:29 Uhr:
>
> Werde mich dann mal den moderneren Programmierabläufen widmen. :-)

Kann ich nur empfehlen. Macht ja auch viel mehr Spaß.

Übrigens: Falls ihr doch mal Sub-Sub-Ordner anlegt (F:\2008\August)
ist es besser die Ordner-Struktur rekursiv zu druchlaufen. Du hattest
zwar eindeutig von nur einer Ebene gesprochen, aber ich poste trotzdem
mal den Code. Prophylaktisch. :-)

Peter

Sub DateiInformationen_auslesen_Peter2()

Const PFAD = "F:\"

With ThisWorkbook.Worksheets("Dateiinfos")
.[A1].Select

.[A3:F65000].ClearContents


.[A1:B1] = Array("Pfad:", PFAD)
.[B2:F2] = Array("Name","Datum","Uhrzeit","Größe","Ordner")
.[C:C].NumberFormat = "dd.mm.yyyy"
.[D:D].NumberFormat = "hh:mm:ss"
.[E:E].NumberFormat = "#,##0"

Call list_files(.[B3:F3], CreateObject( _
"Scripting.FileSystemObject").GetFolder(PFAD))

.[A:F].EntireColumn.AutoFit
End With
End Sub

Sub list_files(r As Range, ordner As Variant)
Dim file As Variant
Dim subordner As Variant

For Each file In ordner.Files

r(1) = file.Name
r(2) = DateValue(file.DateLastModified)
r(3) = TimeValue(file.DateLastModified)
r(4) = file.Size
r(5) = ordner.Path
Set r = r.Offset(1)
Next

For Each subordner In ordner.SubFolders

If (subordner.Attributes And 4) = 0 Then '/System-Ordner/
Call list_files(r, subordner)
End If
Next
End Sub

stevethal

unread,
Mar 18, 2010, 4:19:41 AM3/18/10
to
Hallo,

kann mir als Amateur hier noch jemand weiter helfen und das Script von oben erweitern um die Information "zuletzt gespeichert von"?

Do While DatNam <> ""
.Cells(i, 2) =DatNam
.Cells(i, 3) =Int(FileDateTime(Pfad & DatNam))

.Cells(i, 4) =FileDateTime(Pfad & DatNam) -
Int(FileDateTime(Pfad & DatNam))
.Cells(i, 5) =FileLen(Pfad & DatNam)


'.Cells(i, 6) ='neuer Eintrag zur Angabe des Ordners
(?)

'.Cells(i, 7) ='NEUER EINTRAG MIT "ZULETZT GESPEICHTER VON"
i =3D i + 1
DatNam =3D Dir
Loop

Soweit ich herausgefunden habe findet sich die Info in BuiltinDocumentProperties - aber leider wei? ich nicht, wie ich das hir korrekt einsetzte. Vielen Dank!

Stefan


Peter Schleif wrote:

Re: Dateiinformationen auslesen und in Excel erfassen per VBA-Code
31-Aug-08

Hermann Splitthoff schrieb am 30.08.2008 20:29 Uhr:

Kann ich nur empfehlen. Macht ja auch viel mehr Spa?.

?brigens: Falls ihr doch mal Sub-Sub-Ordner anlegt (F:\2008\August)


ist es besser die Ordner-Struktur rekursiv zu druchlaufen. Du hattest
zwar eindeutig von nur einer Ebene gesprochen, aber ich poste trotzdem
mal den Code. Prophylaktisch. :-)

Peter

Sub DateiInformationen_auslesen_Peter2()

Const PFAD = "F:\"

With ThisWorkbook.Worksheets("Dateiinfos")
.[A1].Select
.[A3:F65000].ClearContents
.[A1:B1] = Array("Pfad:", PFAD)

.[B2:F2] = Array("Name","Datum","Uhrzeit","Gr??e","Ordner")

Previous Posts In This Thread:

On Saturday, August 30, 2008 1:44 PM
Peter Schleif wrote:

Re: Dateiinformationen auslesen und in Excel erfassen per VBA-Code


Hermann Splitthoff schrieb am 30.08.2008 18:21 Uhr:

Hallo Hermann.

Das Durchwandern eines Ordners mir Dir() ist IMHO nicht mehr

zeitgem??. Daf?r gibt es Objekte mit extra daf?r vorgesehenen


Eigenschaften und Methoden. Zum Beispiel hat das Folder-Object eine
Files-Auflistung und eine SubFolders-Auflistung die man bequem mit
For-Each durchlaufen kann. Siehe dazu auch die Links am Ende diese
Postings.

Peter


Sub DateiInformationen_auslesen_Peter()
Dim fso As Object
Dim ordner As Object
Dim subordner As Variant

Dim file As Variant
Dim i As Integer

Const PFAD = "F:\"

i = 3
Set fso = CreateObject("Scripting.FileSystemObject")
Set ordner = fso.GetFolder(PFAD)

With ThisWorkbook.Worksheets("Dateiinfos")
.[A1].Select
.[A3:F10000].ClearContents


.[A1:B1] = Array("Pfad:", PFAD)

.[B2:F2] = Array("Name","Datum","Uhrzeit","Gr??e","Ordner")


.[C:C].NumberFormat = "dd.mm.yyyy"
.[D:D].NumberFormat = "hh:mm:ss"
.[E:E].NumberFormat = "#,##0"

For Each file In ordner.Files


.Cells(i, 2) = file.Name
.Cells(i, 3) = DateValue(file.DateLastModified)
.Cells(i, 4) = TimeValue(file.DateLastModified)
.Cells(i, 5) = file.Size
i = i + 1

Next

For Each subordner In ordner.SubFolders
If (subordner.Attributes And 4) = 0 Then

For Each file In subordner.Files
.Cells(i, 2) = file.Name
.Cells(i, 3) = DateValue(file.DateLastModified)
.Cells(i, 4) = TimeValue(file.DateLastModified)
.Cells(i, 5) = file.Size
.Cells(i, 6) = subordner.Name
i = i + 1
Next
End If
Next

.[A:F].EntireColumn.AutoFit
End With
End Sub


Folder-Object:
http://msdn.microsoft.com/en-us/library/1c87day3(VS.85).aspx

File-Object
http://msdn.microsoft.com/en-us/library/1ft05taf(VS.85).aspx

Files-Auflistung:
http://msdn.microsoft.com/en-us/library/wz72a8c0(VS.85).aspx

SubFolders-Auflistung:
http://msdn.microsoft.com/en-us/library/e1dthkks(VS.85).aspx

On Saturday, August 30, 2008 3:17 PM
Hermann Splitthoff wrote:

Dateiinformationen auslesen und in Excel erfassen per VBA-Code
Hallo liebe Leute,

mit dem weiter unten aufgef=FChrten VBA-Code (hier aus der Newsgroup)


lese ich explizit Dateien bzw. deren Informationen auf einen Laufwerk
aus. Auf dem Laufwerk sind keine weiteren Pfade vorhanden. Diese

Informationen werden dann in einer Exceltabelle ausgegeben. K=FCnftig


werden auch Unterordner auf dem Laufwerk vorhanden sein.

Wie ist dieser VBA-Code umzubauen, damit enthaltene Ordner (eine
Ebene) mit ausgelesen werden und wiederum in einer Exceltabelle =96 mit
Erweiterung der Ordnerangabe =96 ausgegeben werden? Ich bekomme den


Wechsel zwischen den Ordner nicht hin, ohne selber im VBA-Code
herumzufummeln. Das will ich eigentich vermeiden.

Hintergrund der Aktion ist, dass Sicherungsdateien auf einer
Festplatte (Laufwerk F:) kopiert werden und der Stand der Dateien
nachts als einfache DateiInformation gesichert werden sollen. Nun ist

die Anzahl der Dateien so gro=DF geworden, dass je Jahr/Monat ein Ordner


(z.B. 2008_08) angelegt wird, so dass auf Laufwerk F: nur noch Pfade
liegen und darin die Dateien enthalten sind.

Bin f=FCr jede Hilfe dankbar.


Sub DateiInformationen_auslesen()
'
Dim Blatt As Worksheet
Dim Pfad As String
Dim DatNam As String
Dim i As Integer
'

Set Blatt =3D ThisWorkbook.Worksheets("Dateiinfos")
Pfad =3D "F:\"
DatNam =3D Dir(Pfad)


'
Sheets("Dateiinfos").Select
Range("A3:E10000").ClearContents
Range("A1").Select
'
With Blatt

.Cells(1, 1) =3D "Pfad:"
.Cells(1, 2) =3D Pfad
.Cells(2, 2) =3D "Name"
.Cells(2, 3) =3D "Datum"
.Cells(2, 4) =3D "Uhrzeit"
.Cells(2, 5) =3D "Gr=F6=DFe"
.Cells(2, 6) =3D "Ordner" 'neue Spalte in Tabellenblatt
i =3D 3
'
Do While DatNam <> ""
.Cells(i, 2) =3D DatNam
.Cells(i, 3) =3D Int(FileDateTime(Pfad & DatNam))
.Cells(i, 4) =3D FileDateTime(Pfad & DatNam) -
Int(FileDateTime(Pfad & DatNam))
.Cells(i, 5) =3D FileLen(Pfad & DatNam)
'.Cells(i, 6) =3D 'neuer Eintrag zur Angabe des Ordners (?)
i =3D i + 1
DatNam =3D Dir
Loop
'
.Columns("C:C").NumberFormat =3D "DD.MM.YYYY"
.Columns("D:D").NumberFormat =3D "hh:mm:ss"
End With
'
End Sub

Sch=F6nen Gru=DF
Hermann

On Saturday, August 30, 2008 3:17 PM
Hermann Splitthoff wrote:

Re: Dateiinformationen auslesen und in Excel erfassen per VBA-Code
Hallo Peter,

vielen herzlichen Dank f=FCr die Hilfe. Es klappt gut!

Werde mich dann mal den moderneren Programmierabl=E4ufen widmen. :-)

Gru=DF Hermann

On Sunday, August 31, 2008 5:59 AM
Peter Schleif wrote:

Re: Dateiinformationen auslesen und in Excel erfassen per VBA-Code


Hermann Splitthoff schrieb am 30.08.2008 20:29 Uhr:

Kann ich nur empfehlen. Macht ja auch viel mehr Spa?.

?brigens: Falls ihr doch mal Sub-Sub-Ordner anlegt (F:\2008\August)


ist es besser die Ordner-Struktur rekursiv zu druchlaufen. Du hattest
zwar eindeutig von nur einer Ebene gesprochen, aber ich poste trotzdem
mal den Code. Prophylaktisch. :-)

Peter

Sub DateiInformationen_auslesen_Peter2()

Const PFAD = "F:\"

With ThisWorkbook.Worksheets("Dateiinfos")
.[A1].Select
.[A3:F65000].ClearContents
.[A1:B1] = Array("Pfad:", PFAD)

.[B2:F2] = Array("Name","Datum","Uhrzeit","Gr??e","Ordner")


Submitted via EggHeadCafe - Software Developer Portal of Choice
Adding WCF Service References
http://www.eggheadcafe.com/tutorials/aspnet/a1647f10-9aa4-4b0c-bbd9-dfa51a9fab8e/adding-wcf-service-refere.aspx

Andreas Killer

unread,
Mar 18, 2010, 12:39:40 PM3/18/10
to
Steve Thal schrieb:

> kann mir als Amateur hier noch jemand weiter helfen und das Script von oben erweitern um die Information "zuletzt gespeichert von"?

...


> Soweit ich herausgefunden habe findet sich die Info in BuiltinDocumentProperties - aber leider wei? ich nicht, wie ich das hir korrekt einsetzte. Vielen Dank!

Nun ja, es gibt in den BuiltinDocumentProperties zwar eine
"Letzter Autor"-Eigenschaft, aber wie der Name schon sagt sind diese
Eigenschaften "BuildIn" und extern nicht zugänglich.

Das bedeutet Du müsstest jede Datei einzeln öffnen um diese
Eigenschaft auslesen zu können.

Andreas.

Michael Schwimmer

unread,
Mar 18, 2010, 7:37:50 PM3/18/10
to
Hallo Andreas,

On Thu, 18 Mar 2010 17:39:40 +0100, Andreas Killer wrote:
>> Soweit ich herausgefunden habe findet sich die Info in BuiltinDocumentProperties - aber leider wei? ich nicht, wie ich das hir korrekt einsetzte. Vielen Dank!

> Nun ja, es gibt in den BuiltinDocumentProperties zwar eine
> "Letzter Autor"-Eigenschaft, aber wie der Name schon sagt sind diese
> Eigenschaften "BuildIn" und extern nicht zugänglich.
> Das bedeutet Du müsstest jede Datei einzeln öffnen um diese
> Eigenschaft auslesen zu können.

mit Bordmitteln kannst du tatsächlich nur die Datei öffnen und
anschließend diese Eigenschaften auslesen.

Microsoft stellt aber bereits seit Jahren die Dll DsoFile.dll bereit,
mit der man die Eigenschaften von OLE-Dokumenten auslesen und sogar
ändern kann. Die neuste wurde vom Office-Team wurde für die Verwendung
mit .NET-Programmiersprachen entworfen, kann aber problemlos mit VBA
benutzt werden. Ist aber alles ohne offiziellen Support oder einer
Garantie!

Wenn man diese auf dem System registriert (regsvr32.exe), funktioniert
aber der Code nicht mehr, der auf die alte zugeschnitten war. In
Firmennetzwerken muss man auch immer erst einmal die Erlaubnis haben,
die Datei überhaupt zu installieren.

Hier mal auf die Schnelle etwas Code dazu:

Public Sub TestDSOFile()
Dim varRet As Variant
Dim colInfos As Collection
Dim strResult As String

varRet = Application.GetOpenFilename( _
"Excel Files (*.xls;*.xlsm;*.xlsx), *.xls;*.xlsm;*.xlsx" & _
",Word Files (*.doc;*.docm;*.docx), *.doc;*.docm;*.docx" & _
",All Files (*.*), *.*")

If varRet <> False Then
Set colInfos = GetBuiltInProps(CStr(varRet))
End If

On Error Resume Next

' Möglich sind auch andere Objekte, nicht nur Strings,
' der Einfachheit halber die Fehlerbehandlung
For Each varRet In colInfos("ItemNames")
strResult = strResult & varRet & " : " & _
CStr(colInfos(CStr(varRet))) & vbCrLf
Next

' Ausgabe in einer Messagebox, möglicherweise werden nicht alle
' Zeilen dargestellt, dann in der Schleife vbCrLf durch ein
' paar Leerzeichen ersetzen
strResult = Left(strResult, Len(strResult) - 2)
MsgBox strResult

End Sub

Public Function GetBuiltInProps(strFile As String) As Collection
Dim objFile As Object
Dim objCustomProp As Object
Dim colResult As New Collection
Dim colItems As New Collection

' Code zum Testen der dsofile.dll von M$.
' OLE Document Properties können mittels
' der dsofile.dll ausgelesen und geschrieben
' werden. Frei bei M$, aber ohne Support
' Link bitte in eine Zeile
' Einige Erklärungen: http://support.microsoft.com/kb/224351/de
' Download:
http://www.microsoft.com/downloads/details.aspx?FamilyId=9BA6FAC6-520B-4A0A-878A-53EC8300C4C2&displaylang=en

Set objFile = CreateObject("DSOFile.OleDocumentProperties")

objFile.Open strFile

On Error Resume Next

Set colDummy = New Collection

With objFile.SummaryProperties

colItems.Add "ApplicationName"
colResult.Add .ApplicationName, "ApplicationName"

colItems.Add "Author"
colResult.Add .Author, "Author"

colItems.Add "ByteCount"
colResult.Add .ByteCount, "ByteCount"

colItems.Add "Category"
colResult.Add .Category, "Category"

colItems.Add "CharacterCount"
colResult.Add .CharacterCount, "CharacterCount"

colItems.Add "CharacterCountWithSpaces"
colResult.Add .CharacterCountWithSpaces, "CharacterCountWithSpaces"

colItems.Add "Comments"
colResult.Add .Comments, "Comments"

colItems.Add "Company"
colResult.Add .Company, "Company"

colItems.Add "DateCreated"
colResult.Add .DateCreated, "DateCreated"

colItems.Add "DateLastPrinted"
colResult.Add .DateLastPrinted, "DateLastPrinted"

colItems.Add "DateLastSaved"
colResult.Add .DateLastSaved, "DateLastSaved"

colItems.Add "DigitalSignature"
colResult.Add .DigitalSignature, "DigitalSignature"

colItems.Add "DocumentSecurity"
colResult.Add .DocumentSecurity, "DocumentSecurity"

colItems.Add "HiddenSlideCount"
colResult.Add .HiddenSlideCount, "HiddenSlideCount"

colItems.Add "Keywords"
colResult.Add .Keywords, "Keywords"

colItems.Add "LastSavedBy"
colResult.Add .LastSavedBy, "LastSavedBy"

colItems.Add "LineCount"
colResult.Add .LineCount, "LineCount"

colItems.Add "Manager"
colResult.Add .Manager, "Manager"

colItems.Add "MultimediaClipCount"
colResult.Add .MultimediaClipCount, "MultimediaClipCount"

colItems.Add "NoteCount"
colResult.Add .NoteCount, "NoteCount"

colItems.Add "PageCount"
colResult.Add .PageCount, "PageCount"

colItems.Add "ParagraphCount"
colResult.Add .ParagraphCount, "ParagraphCount"

colItems.Add "PresentationFormat"
colResult.Add .PresentationFormat, "PresentationFormat"

colItems.Add "RevisionNumber"
colResult.Add .RevisionNumber, "RevisionNumber"

colItems.Add "SharedDocument"
colResult.Add .SharedDocument, "SharedDocument"

colItems.Add "SlideCount"
colResult.Add .SlideCount, "SlideCount"

colItems.Add "Subject"
colResult.Add .Subject, "Subject"

colItems.Add "Template"
colResult.Add .Template, "Template"

colItems.Add "Thumbnail"
colResult.Add .Thumbnail, "Thumbnail"

colItems.Add "Title"
colResult.Add .Title, "Title"

colItems.Add "TotalEditTime"
colResult.Add .TotalEditTime, "TotalEditTime"

colItems.Add "Version"
colResult.Add .Version, "Version"

colItems.Add "WordCount"
colResult.Add .WordCount, "WordCount"

End With

With objFile

colItems.Add "CLSID"
colResult.Add .CLSID, "CLSID"

colItems.Add "IsDirty"
colResult.Add .IsDirty, "IsDirty"

colItems.Add "ProgID"
colResult.Add .ProgID, "ProgID"

colItems.Add "CustomPropertiesCount"
colResult.Add .CustomProperties.Count, "CustomPropertiesCount"

For Each objCustomProp In .CustomProperties
colItems.Add objCustomProp.Name
colResult.Add objCustomProp.Value, objCustomProp.Name
Next

End With

colResult.Add colItems, "ItemNames", 1

Set GetBuiltInProps = colResult

End Function

Link zur Datei im Quellcode!

Viele Grüße
Michael


0 new messages