Print Directory to Excel

[Melody]

Hi,

I was able to find an Excel Spreadsheet with a macro to print the directory
structure. The script is below. I want to add the Owner to the printout but
I'm not very proficient in VB. I found where to add the column heading but
not the actual programming to pull it in the spreadsheet. Can anyone help
add that parameter to this script?

Thanks.

'Concept by Michael Hayes, core code from MS example
Global L
Global R
Global C
Global LastR
Global IsCD
Global MaybeCD
Global Folderspec(100)
Sub Shell()
Application.ScreenUpdating = False
Application.ActiveSheet.UsedRange
IsCD = False
MaybeCD = False
L = 1
R = 2
LastR = R
Sheets("Data").Select
On Error GoTo ErrDir
If Cells(2, 2).Value = "CD" Then IsCD = True
If Cells(2, 2).Value = "cd" Then IsCD = True
Cells.Interior.ColorIndex = 2
Cells.Font.ColorIndex = 1
Folderspec(L) = Cells(R, 1).Value
If Right(Folderspec(L), 1) = "\" Then
Else
GoTo ErrDir
End If
ActiveWindow.Zoom = 75
Cells.ClearContents
Cells(1, 1).Value = "Path"
Cells(1, 2).Value = "File"
Cells(1, 3).Value = "Last Saved"
Cells(1, 4).Value = "Last Accessed"
Cells(1, 5).Value = "File (B)"
Cells(1, 6).Value = "Directory (B)"
Cells(1, 7).Value = "Owner"
Cells(1, 8).Value = Application.WorksheetFunction.Text(Now(), "ddd dd
mmm yyyy hh:mm")
Cells(2, 2).Select
ActiveWindow.FreezePanes = True
ActiveWindow.Zoom = 75
Call ShowFileList
Application.ScreenUpdating = True
Set W = Application.WorksheetFunction
Cells(LastR, 6).Value = W.Sum(Range(Cells(LastR, 5), Cells(R, 5)))
Cells.AutoFilter Field:=6, Criteria1:="<>"
Sheets("Summary").Select
Cells.ClearContents
Cells.ClearFormats
Sheets("Data").Select
Range(Cells(1, 1), Cells(R, 6)).Copy
Sheets("Summary").Select
Cells(1, 1).Select
ActiveSheet.Paste
Cells.EntireColumn.AutoFit
Columns("B:E").Select
Selection.Delete
Cells(2, 2).Select
ActiveWindow.FreezePanes = True
ActiveWindow.Zoom = 75
Call Sort
Sheets("Data").Select
Cells.AutoFilter
Call Display
Exit Sub
ErrDir:
Select Case Err
Case 1004
Prompt = "Tried to write past end of Sheet"
Case Else
Sheets("Data").Select
D = Cells(2, 1).Value
If MaybeCD Then
Prompt = "The Source may be on a CD. If this is the case
please enter CD in cell B2"
Else
Prompt = "The current Root Path is " & D & vbCrLf & _
" If this is not correct, then enter a new path
in Cell A2 in 'Data'" & vbCrLf & _
"Note that the path must end with \ "
End If
End Select
MsgBox (Prompt)
End Sub
Sub ShowFileList()
Dim fs, f, f1, fc, s
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(Folderspec(L))
Set fc = f.Files
Cells(R, 1).Value = Folderspec(L)
Application.ScreenUpdating = True
Cells(R, 1).Select
Application.ScreenUpdating = False
Set W = Application.WorksheetFunction
Cells(LastR, 6).Value = W.Sum(Range(Cells(LastR, 5), Cells(R, 5)))
LastR = R
On Error Resume Next
For Each f1 In fc
Select Case Err
Case 70 'Don't have access
With Cells(R, 2)
.Value = "Access to this directory is denied"
.Font.ColorIndex = 3
End With
On Error GoTo 0
Exit Sub
Case 0 'Normal Access
On Error GoTo 0
R = R + 1
With Cells(R, 1)
.Value = Folderspec(L)
.Font.ColorIndex = 15
End With
Cells(R, 2).Value = f1.Name
Cells(R, 3).Value = f1.DateLastModified
If IsCD Then
Else
MaybeCD = True
Cells(R, 4).Value = f1.DateLastAccessed
MaybeCD = False
End If
Cells(R, 5).Value = f1.Size
Case Else 'Not sure what this error would be
Exit Sub
End Select
On Error Resume Next
Next
On Error GoTo 0
Call ShowFolderList
End Sub
Sub ShowFolderList()
Dim fs, f, f1, s, sf
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(Folderspec(L))
Set sf = f.SubFolders
a = f.SubFolders.Count
For Each f1 In sf
L = L + 1
Folderspec(L) = Folderspec(L - 1) & f1.Name & "\"
R = R + 1
Call ShowFileList
L = L - 1
Next
End Sub
Sub Display()
Set W = Application.WorksheetFunction
Cells.Interior.ColorIndex = 2
Range(Cells(1, 1), Cells(1, 106)).Interior.ColorIndex = 34
MaxFile = W.Max(Range(Cells(2, 5), Cells(65536, 5)))
MaxDirectory = W.Max(Range(Cells(2, 6), Cells(65536, 6)))
Cells(65536, 5).Select
Selection.End(xlUp).Select
EOD = ActiveCell.Row
For R = 2 To EOD
If Cells(R, 5).Value = "" Then
N = 99 * Round(Cells(R, 6).Value / MaxDirectory, 2)
Range(Cells(R, 7), Cells(R, 7 + N)).Interior.ColorIndex = 3
Else
N = 99 * Round(Cells(R, 5).Value / MaxFile, 2)
Range(Cells(R, 7), Cells(R, 7 + N)).Interior.ColorIndex = 4
End If
Cells(R + 1, 5).Select
Next R
R = R + 1
Cells(R, 2).Value = "Total Size"
Cells(R, 5).Formula = "=Subtotal(9,E2:E" & R - 1 & ")"
Cells(R, 6).Formula = "=Subtotal(9,F2:F" & R - 1 & ")"
R = R + 2
Cells(R, 2).Value = "Total Number"
Cells(R, 5).Formula = "=Subtotal(2,E2:E" & R - 3 & ")"
Cells(R, 6).Formula = "=Subtotal(2,F2:F" & R - 3 & ")"
Range(Cells(1, 1), Cells(EOD, 6)).Select
Selection.AutoFilter
Cells(1, 1).Select
End Sub
Sub Sort()
Range("A2").Select
Selection.CurrentRegion.Select
Selection.Sort Key1:=Range("B2"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("B2").Select
End Sub

 

[Kevin B]

See if this free add-in from Chip Pearson's website doesn't do the trick.

It installs as an XLA add-in and is accessed via the TOOLS menu in Excel.

http://www.cpearson.com/Excel/FolderTree.aspx

 

[Melody]

Thanks for the link. I can't run that program. I'm using my PC at work and
there are restrictions to installing programs. That's why I wanted to use
the VB programming.

 

[JP]

Do you mean the Owner of the folder? That sounds like an API thing. Or
maybe the Windows Script Host or FileSystemObject.

But I'm confused. If you can use the code in your original post, why
can't you use Chip's add-in? They're both VBA code. I must be missing
something here.

--JP

 

[Melody]

Yes, I mean the owner of the file/folder. I can't use the add-in because it
runs a .exe file and at work our pc's are set up to not allow us to install
programs. Sometimes it works sometimes it doesn't. I guess it depends on
how the program is set up to run.

Anyway, just as you can see in the code that the path, filename, last
saved, etc is displayed, I also wan to display the owner of the file/folder.
I don't know VBA enough to know what the value for that setting might be or
where to exactly put it in this code.

 

[JP]

Sorry, let me go back one step. Are you able to view this information
manually? If so, where specifically do you see it?

I don't recall there being an "owner" property of a folder or file,
only a "created by" or "last saved by" property. How would it be
determined or enforced?

--JP

 

[Melody]

Open Windows explorer (2003), if you right click on the column headings
you'll see a list of available options. One of those is Owner. My guess is
that's the same as Last Saved by.

 

[JP]

Thank you. Here's some sample code that will give you the Owner
property of the files in a folder. This routine simply prints the
filename and owner into a worksheet, do you need help integrating it
into your existing code?

Sub GetOwner()

Dim f As Object
Dim sh As Object
Dim fl As Object
Dim NextRow As Long

Set sh = CreateObject("Shell.Application")
Set fl = sh.Namespace("C:\My Files\")

NextRow = WorksheetFunction.CountA(Range("A:A")) + 1

For Each f In fl.Items
Cells(NextRow, 1).Value = f.Name
Cells(NextRow, 2).Value = fl.getdetailsof(f, 8)
NextRow = NextRow + 1
Next f

End Sub

(Based on http://classicasp.aspfaq.com/files/...er-author-and-other-properties-of-a-file.html)


--JP

 

[Melody]

Simple to you, not to me. If you could integrate it into the existing code
that would be great. As I said, I'm not very experienced with Visual Basic.
I know enough to somewhat figure out a program which is probably just enough
to be dangerous.

 

[Gord Dibben]

Owner is the computer name/owner.

What you want is the "Author" of the workbook and would not be the "last
saved by".

To see the "author" choose that from the dropdown list of available options
in Windows Explorer.

To return author to a cell use this code.

Sub author()
ActiveSheet.Range("A1").Value = _
ThisWorkbook.BuiltinDocumentProperties("Author")
End Sub


Gord Dibben MS Excel MVP

 

[Gord Dibben]

If you want the Author of the file/workbook change the 8 to 9

Cells(NextRow, 2).Value = fl.getdetailsof(f, 9)


Gord

 

[JP]

Gord,

What is the difference? Wouldn't the owner of the computer be the one
who authored the document?

--JP

 

[Gord Dibben]

Not necessarily.

If I sent you a workbook and you stored it in a folder it would have myself
as author and yourself as owner.

Which would OP want to see?


Gord

 

[JP]

Do you want the owner of the document, or the author? Please see
Gord's replies above; the owner and the author may be different
people.


--JP