Sabtu, 16 Februari 2013

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

 

Hehehe.... The filesystem object is your friend!

Lisa

Sent: Fri, Feb 15, 2013 7:41 pm

Subject: 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
-----------------------------------------

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