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) |
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