Advertisement

08.15.2008 at 02:59AM PDT, ID: 23650827
[x]
Attachment Details
[x]
The Solution Rating System

With so many solutions, how can you tell which solutions are most likely to help you and which ones are not? To provide you with a tool to use, we rate our solutions based on various elements that most accurately determine if a solution is a quality solution. To explain what factors affect the solution rating, here are the elements we take into consideration when formulating our solution rating.

  • The Grade of the Solution
  • The Zone Rank of the Expert Providing the Solution
  • The Number of Author and Expert Comments
  • The Number of Experts Contributing
  • The Feedback of the Community

Your Input Matters
Because of the way the system is set up, the most important variable in this equation is you. As a member of Experts Exchange, you are able to cast your vote on the quality of the solutions in regard to how complete, accurate, helpful and easy to understand each solution is. When you provide your feedback, each rating is adjusted accordingly. So, if you see a solution that has a poor rating that you think is a good solution, let us know by rating it. As you do, the rating will be adjusted and will become more accurate for other members of our site.

If you have any suggestions that you would like to make for our rating system, please ask a question in the Suggestions Zone of Community Support.

Thank you!
9.2

populate spreadsheet with file name and properties from a specified directory

Asked by grayderek in Microsoft Excel Spreadsheet Software, Access Coding/Macros, VB Script

Tags: , , ,

I have a macro (compliments of EE) that goes to a specified directory and populates a spreadsheet with: File name, Size, Modified Date, Last Accessed, Created Date and Full Path (code attached)
Can anyone provide the code amendments to retrieve the: subject, author, manger, and company from the file properties?
Start Free Trial 
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:

Sub PopulateDirectoryList()
     'dimension variables
    Dim objFSO As FileSystemObject, objFolder As Folder
    Dim objFile As File, strSourceFolder As String, x As Long, i As Long
    Dim wbNew As Workbook, wsNew As Worksheet
     
    ToggleStuff False 'turn of screenupdating
     
    Set objFSO = New FileSystemObject 'set a new object in memory
    strSourceFolder = BrowseForFolder 'call up the browse for folder routine
    If strSourceFolder = "" Then Exit Sub
     
    Workbooks.Add 'create a new workbook
     
    Set wbNew = ActiveWorkbook
    Set wsNew = wbNew.Sheets(1) 'set the worksheet
    wsNew.Activate
     'format a header
    With wsNew.Range("A1:F1")
        .Value = Array("File", "Size", "Modified Date", "Last Accessed", "Created Date", "Full Path", "Size")
        .Interior.ColorIndex = 7
        .Font.Bold = True
        .Font.Size = 12
    End With
     
    With Application.FileSearch
        .LookIn = strSourceFolder 'look in the folder browsed to
        .FileType = msoFileTypeAllFiles 'get all files
        .SearchSubFolders = True 'search sub directories
        .Execute 'run the search
         
        For x = 1 To .FoundFiles.Count 'for each file found, by the count (or index)
            i = x 'make the variable i = x
            If x > 60000 Then 'if there happens to be more than multipls of 60,000 files, then add a new sheet
                i = x - 60000 'set i to the right number for row placement below
                Set wsNew = wbNew.Sheets.Add(after:=Sheets(wsNew.Index))
                With wsNew.Range("A1:F1")
                    .Value = Array("File", "Parent Folder", "Full Path", "Modified Date", _
                    "Last Accessed", "Size")
                    .Interior.ColorIndex = 7
                    .Font.Bold = True
                    .Font.Size = 12
                End With
                 
            End If
            On Error GoTo Skip 'in the event of a permissions error
             
            Set objFile = objFSO.GetFile(.FoundFiles(x)) 'set the object to get it's properties
            With wsNew.Cells(1, 1) 'populate the next row with the variable data
                .Offset(i, 0) = objFile.Name
                .Offset(i, 1) = Format(objFile.Size, "0,000") & " KB"
                .Offset(i, 2) = objFile.DateLastModified
                .Offset(i, 3) = objFile.DateLastAccessed
                .Offset(i, 4) = objFile.DateCreated
                .Offset(i, 5) = objFile.Path
                 
            End With
             ' Next objFile
Skip:
             'this is in case a Permission denied error comes up or an unforeseen error
             'Do nothing, just go to next file
        Next x
        wsNew.Columns("A:F").AutoFit
         
    End With
     
     'clear the variables
    Set objFolder = Nothing
    Set objFile = Nothing
    Set objFSO = Nothing
    Set wsNew = Nothing
    Set wbNew = Nothing
     
    ToggleStuff True 'turn events back on
End Sub
Sub ToggleStuff(ByVal x As Boolean)
    Application.ScreenUpdating = x
    Application.EnableEvents = x
End Sub
 
 
 
Function BrowseForFolder(Optional OpenAt As Variant) As Variant
     '''Code from kpuls, www.VBAExpress.com..portion of Knowledge base submission
     ''www.codeguru.com
     
    Dim ShellApp As Object
    Set ShellApp = CreateObject("Shell.Application"). _
    BrowseForFolder(0, "Please choose a folder", 0, OpenAt)
     
    On Error Resume Next
    BrowseForFolder = ShellApp.self.Path
    On Error GoTo 0
     
    Set ShellApp = Nothing
     
    Select Case Mid(BrowseForFolder, 2, 1)
    Case Is = ":"
        If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
    Case Is = "\"
        If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
    Case Else
        GoTo Invalid
    End Select
    Exit Function
     
Invalid:
     
     
    ToggleStuff True
End Function
[+][-]08.15.2008 at 03:45AM PDT, ID: 22237027

At Experts Exchange, members can ask their questions to thousands of technology professionals, also known as Experts. Experts compete and collaborate to answer those questions by leaving comments like this one.

Start your 7-day free trial to view this Expert Comment or ask the Experts your question.

 
[+][-]08.15.2008 at 08:11AM PDT, ID: 22238870

Often, when Experts are collaborating with members who have asked questions, they will request additional information about the problem. Askers respond with an author comment like this one.

Start your 7-day free trial to view this Author Comment or ask the Experts your question.

 
[+][-]08.15.2008 at 08:54AM PDT, ID: 22239286

View this solution now by starting your 7-day free trial. Setting up your free trial is quick, easy, and secure. We will return you to this solution, unlocked, when you're done.

 

About this solution

Zones: Microsoft Excel Spreadsheet Software, Access Coding/Macros, VB Script
Tags: microsoft, excel 2003, 2003, visual basic, macro
Sign Up Now!
Solution Provided By: brettdj
Participating Experts: 1
Solution Grade: A
 
 
 
Loading Advertisement...
20081112-EE-VQP-42 / EE_QW_2_20070628