Jumat, 15 Februari 2013

Re: [ExcelVBA] Using Excel VBA to generate an archive of document metadata

 

I threw this together pretty quickly.
with just a little testing.

hope it gives you someplace to start.

----------------------------------------------------------
Option Explicit
'err.number & ": " & err.description
Public fso, ListRow, RepSheet
Sub List_All_Files()
    Dim StartPath, stat, File_Cnt
    '---------------------------------
    StartPath = "C:\temp"
    RepSheet = "All_Files"
    '---------------------------------
    Set fso = CreateObject("scripting.filesystemobject")
    '---------------------------------
    stat = Clear_Report
    '---------------------------------
    File_Cnt = Get_Folders(StartPath)
    '---------------------------------
    Application.StatusBar = False
    MsgBox File_Cnt & " files listed"
End Sub
Function Get_Folders(FolderName)
    Dim File, Files, f, fil
    Dim Folders, Folder
    Dim File_Cnt
    Application.StatusBar = "Accessing folder: " & FolderName
    On Error Resume Next
    Set Folder = fso.getfolder(FolderName)
    Set Files = Folder.Files
    For Each File In Files
        File_Cnt = File_Cnt + 1
        ListRow = ListRow + 1
        Set f = fso.getfile(File.Path)
        Sheets(RepSheet).Cells(ListRow, "A").Value = f.Name
        Sheets(RepSheet).Cells(ListRow, "B").Value = f.Path
        Sheets(RepSheet).Cells(ListRow, "C").Value = f.Size
        Sheets(RepSheet).Cells(ListRow, "D").Value = f.datecreated
        Sheets(RepSheet).Cells(ListRow, "E").Value = f.datelastmodified
        Sheets(RepSheet).Cells(ListRow, "F").Value = Get_Author(f.Path)
       
'        If (File_Cnt Mod 100 = 0) Then Application.StatusBar = Share_Name & ":
Folders: " & Fldr_Cnt & " Files: " & File_Cnt
    Next File
    '--------------------------------------------------------
    Set Folders = Folder.subfolders
    For Each Folder In Folders
        File_Cnt = File_Cnt + Get_Folders(Folder)
    Next Folder
    '--------------------------------------------------------
    On Error GoTo 0
    Get_Folders = File_Cnt
End Function
Function Clear_Report()
    Sheets(RepSheet).Range("A2:Z1000000").ClearContents
    Sheets(RepSheet).Range("A1").Value = "FileName"
    Sheets(RepSheet).Range("B1").Value = "Path"
    Sheets(RepSheet).Range("C1").Value = "Size"
    Sheets(RepSheet).Range("D1").Value = "Date Created"
    Sheets(RepSheet).Range("E1").Value = "Date Modified"
    ListRow = 1
End Function
Function Get_Author(fullname)
    Dim Ext
     Ext = fso.getextensionname(fullname)
    Select Case UCase(Ext)
        Case "XLS", "XLSX", "XLSM", "XLSB"
            Application.Workbooks.Open fullname
            Get_Author = ActiveWorkbook.BuiltinDocumentProperties("Last author")
            ActiveWorkbook.Close savechanges:=False
        Case "DOC", "DOCX", "DOCM", "DOCB"
    End Select
   
End Function

 
Paul
-----------------------------------------
"Do all the good you can,
By all the means you can,
In all the ways you can,
In all the places you can,
At all the times you can,
To all the people you can,
As long as ever you can." - John Wesley
-----------------------------------------

________________________________
From: Dr John C Bullas john.bullas@gmail.com>
To: ExcelVBA@yahoogroups.com
Sent: Fri, February 15, 2013 12:38:58 PM
Subject: Re: [ExcelVBA] Using Excel VBA to generate an archive of document
metadata

Could you include a dummy macro to open each file then I will modify the
appropriate line for the right field name

Many thanks

Dr B
On 15 Feb 2013 17:10, "Paul Schreiner" schreiner_paul@att.net> wrote:

> Dr. B.
>
> It's pretty simple to parse through the folders and generate a list of file
> names, path names and last modified times.
>
> But getting the author's userid isn't quite so easy.
> I'll throw together some code that will allow you to get the rest of the
> info,
> but I THINK the only way to get it to give you the author is to have the
> macro
> open each file.
> Depending on the file type, there is probably parameters like:
>
> wb.BuiltinDocumentProperties("Last author")
>
> that would give you the last user name for Excel files.
>
> I'll throw something together for the folder search.
>
> Paul
> -----------------------------------------
> "Do all the good you can,
> By all the means you can,
> In all the ways you can,
> In all the places you can,
> At all the times you can,
> To all the people you can,
> As long as ever you can." - John Wesley
> -----------------------------------------
>
>
>
>
> ________________________________
> From: Dr John C Bullas john.bullas@gmail.com>
> To: ExcelVBA@yahoogroups.com
> Sent: Fri, February 15, 2013 11:30:41 AM
> Subject: [ExcelVBA] Using Excel VBA to generate an archive of document
> metadata
>
>
> Good Afternoon/Morning/Evening!
>
> I have a question for the forum:
>
> I have a (very) large number of server directories with up to several
> hundred files in each,
> the majority of them are microsoft office generated documents
>
> Is there a way to extract the
>
> path / last modified / author
>
> ...fields in the document properties into a long spreadsheet to then
> identify the main suspects and last
> users of the directory tree via filters and or sorting of the spreadsheet
>
> Many thanks in advance
> (a bit lost where it comes to grubbing around in a servers undergarments)
>
> Dr B
>
> --
>
> ===========================
> http://uk.linkedin.com/in/drjohnbullas
>
>
>
> [Non-text portions of this message have been removed]
>
>
>
> ------------------------------------
>
> ----------------------------------
> Be sure to check out TechTrax Ezine for many, free Excel VBA articles! Go
> here: http://www.mousetrax.com/techtrax to enter the ezine, then search
> the ARCHIVES for EXCEL VBA.
>
> ----------------------------------
> Visit our ExcelVBA group home page for more info and support files:
> http://groups.yahoo.com/group/ExcelVBA
>
> ----------------------------------
> More free tutorials and resources available at:
> http://www.mousetrax.com
>
> ----------------------------------Yahoo! Groups Links
>
>
>
>

[Non-text portions of this message have been removed]

------------------------------------

----------------------------------
Be sure to check out TechTrax Ezine for many, free Excel VBA articles! Go here:
http://www.mousetrax.com/techtrax to enter the ezine, then search the ARCHIVES
for EXCEL VBA.

----------------------------------
Visit our ExcelVBA group home page for more info and support files:
http://groups.yahoo.com/group/ExcelVBA

----------------------------------
More free tutorials and resources available at:
http://www.mousetrax.com

----------------------------------Yahoo! Groups Links

[Non-text portions of this message have been removed]

__._,_.___
Reply via web post Reply to sender Reply to group Start a New Topic Messages in this topic (5)
Recent Activity:
----------------------------------
Be sure to check out TechTrax Ezine for many, free Excel VBA articles! Go here: http://www.mousetrax.com/techtrax to enter the ezine, then search the ARCHIVES for EXCEL VBA.

----------------------------------
Visit our ExcelVBA group home page for more info and support files:
http://groups.yahoo.com/group/ExcelVBA

----------------------------------
More free tutorials and resources available at:
http://www.mousetrax.com

----------------------------------
.

__,_._,___

Tidak ada komentar:

Posting Komentar