Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.worksheet.functions
|
|||
|
|||
List File Properties - Author
Does anyone have a macro that would list the files and the properties in
this case the author within folders. Thanks Shona |
#2
Posted to microsoft.public.excel.worksheet.functions
|
|||
|
|||
List File Properties - Author
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" wrote in message ... Does anyone have a macro that would list the files and the properties in this case the author within folders. Thanks Shona |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
File A and File B Together | Excel Discussion (Misc queries) | |||
how do you turn an email address list into an Excel csv or txt file? | Excel Worksheet Functions | |||
Where does Excel get the default properties without startup file? | Excel Discussion (Misc queries) | |||
Printing/Displaying File Properties | Excel Discussion (Misc queries) | |||
How can you print file properties in an Excel spreadsheet? | Excel Discussion (Misc queries) |