List File Properties - Author

[SS]

Does anyone have a macro that would list the files and the properties in
this case the author within folders.

Thanks
Shona

[Bob Phillips]

Yes you can, but you have to install DSO. You can get it at
http://support.microsoft.com/?id=224351
and set a reference to "DSO OLE Document Properties Reader 2.0." in the
VBIDE

Option Explicit

Const COL_Application As String = 1
Const COL_Author As String = 2
Const COL_Version As String = 3
Const COL_Subject As String = 4
Const COL_Category As String = 5
Const COL_Company As String = 6
Const COL_Keywords As String = 7
Const COL_Manager As String = 8
Const COL_LastSavedBy As String = 9
Const COL_WordCount As String = 10
Const COL_PageCount As String = 11
Const COL_ParagraphCount As String = 12
Const COL_LineCount As String = 13
Const COL_CharacterCount As String = 14
Const COL_CharacterCountspaces As String = 15
Const COL_ByteCount As String = 16
Const COL_PresFormat As String = 17
Const COL_SlideCount As String = 18
Const COL_NoteCount As String = 19
Const COL_HiddenSlides As String = 20
Const COL_MultimediaClips As String = 21
Const COL_DateCreated As String = 22
Const COL_DateLastPrinted As String = 23
Const COL_DateLastSaved As String = 24
Const COL_TotalEditingTime As String = 25
Const COL_Template As String = 26
Const COL_Revision As String = 27
Const COL_IsShared As String = 28
Const COL_CLSID As String = 29
Const COL_ProgID As String = 30
Const COL_OleFormat As String = 1
Const COL_OleType As String = 32

Sub ListFileAttributes()
Dim FSO As Object
Dim i As Long
Dim sFolder As String
Dim fldr As Object
Dim Folder As Object
Dim file As Object
Dim Files As Object
Dim this As Workbook
Dim aryFiles
Dim cnt As Long
Dim sh As Worksheet

Set FSO = CreateObject("Scripting.FileSystemObject")

Set this = ActiveWorkbook
sFolder = "C:\MyTest"
Set Folder = FSO.GetFolder(sFolder)
Set Files = Folder.Files
cnt = 0
ReDim aryFiles(1 To 33, 1 To 1)
For Each file In Files
If file.Type = "Microsoft Excel Worksheet" Then
Call DSO(file.Path, aryFiles)
End If
Next file

On Error Resume Next
Set sh = Worksheets("ListOfFiles")
On Error GoTo 0
If sh Is Nothing Then
Worksheets.Add.Name = "ListOfFiles"
Else
sh.Cells.ClearContents
End If

For i = LBound(aryFiles, 2) To UBound(aryFiles, 2)
Cells(i + 1, "A").Value = aryFiles(COL_Author, i)
Next i
Columns("A:C").AutoFit

End Sub


Sub DSO(ByVal FileName As String, ByRef aryData)
Static notFirstTime As Boolean
Dim fOpenReadOnly As Boolean
Dim DSO As DSOFile.OleDocumentProperties
Dim oSummProps As DSOFile.SummaryProperties
Dim oCustProp As DSOFile.CustomProperty
Dim iNext As Long

If notFirstTime Then
iNext = UBound(aryData, 2) + 1
Else
iNext = UBound(aryData, 2)
notFirstTime = True
End If
ReDim Preserve aryData(1 To 33, 1 To iNext)

Set DSO = New DSOFile.OleDocumentProperties
DSO.Open FileName, fOpenReadOnly, dsoOptionOpenReadOnlyIfNoWriteAccess

'Get the SummaryProperties (these are built-in set)...
Set oSummProps = DSO.SummaryProperties
aryData(1, iNext) = oSummProps.ApplicationName
aryData(2, iNext) = oSummProps.Author
aryData(3, iNext) = oSummProps.Version
aryData(4, iNext) = oSummProps.Subject
aryData(5, iNext) = oSummProps.Category
aryData(6, iNext) = oSummProps.Company
aryData(7, iNext) = oSummProps.Keywords
aryData(8, iNext) = oSummProps.Manager
aryData(9, iNext) = oSummProps.LastSavedBy
aryData(10, iNext) = oSummProps.WordCount
aryData(11, iNext) = oSummProps.PageCount
aryData(12, iNext) = oSummProps.ParagraphCount
aryData(13, iNext) = oSummProps.LineCount
aryData(14, iNext) = oSummProps.CharacterCount
aryData(15, iNext) = oSummProps.CharacterCountWithSpaces
aryData(16, iNext) = oSummProps.ByteCount
aryData(17, iNext) = oSummProps.PresentationFormat
aryData(18, iNext) = oSummProps.SlideCount
aryData(19, iNext) = oSummProps.NoteCount
aryData(20, iNext) = oSummProps.HiddenSlideCount
aryData(21, iNext) = oSummProps.MultimediaClipCount
aryData(22, iNext) = oSummProps.DateCreated
aryData(23, iNext) = oSummProps.DateLastPrinted
aryData(24, iNext) = oSummProps.DateLastSaved
aryData(25, iNext) = oSummProps.TotalEditTime
aryData(26, iNext) = oSummProps.Template
aryData(27, iNext) = oSummProps.RevisionNumber
aryData(28, iNext) = oSummProps.SharedDocument
'Add a few other items that pertain to OLE files only...
If DSO.IsOleFile Then
aryData(29, iNext) = DSO.CLSID
aryData(30, iNext) = DSO.progID
aryData(31, iNext) = DSO.OleDocumentFormat
aryData(32, iNext) = DSO.OleDocumentType
End If

'Now the custom properties
For Each oCustProp In DSO.CustomProperties
aryData(33, iNext) = CStr(oCustProp.Value)
Next oCustProp

Set oCustProp = Nothing
Set oSummProps = Nothing
Set DSO = Nothing

End Sub





--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)

"SS" <Student.1@uk.bosch.com> wrote in message
news:e7gviu$1g3$1@ns2.fe.internet.bosch.com...
> Does anyone have a macro that would list the files and the properties in
> this case the author within folders.
>
> Thanks
> Shona
>
>