Hi.

I've tried searching for this answer to my problem for the past 4 hours to no avail. I just can't wrap my head around it. Here's the problem...

The boss was super impressed with what I did to the "Directory Listing.xls" file (found here on last post: Finding Paths >255 - Excel Help & Excel Macro Help) and how I organized it for what we needed. But now they want an extra cell to show who is the owner of each individual file! I'm not a wizard, so I am in dire need of help. Here's what I've got so far:

Note: This is different from what is linked to above.

Code:
    '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 = "**" Then IsCD = True
    If Cells(2, 2).Value = "**" 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 = 100
    Cells.ClearContents
    Cells(1, 1).Value = "Path"
    Cells(1, 2).Value = "File Name"
    Cells(1, 3).Value = "Date Modified (24 hour clock)"
    Cells(1, 4).Value = "Last Accessed (24 hour clock)"
    Cells(1, 5).Value = "File Size in Bytes"
    Cells(1, 6).Value = "Total Directory Size in Bytes"
    Cells(1, 7).Value = "Date Created (24 Hour Clock)"
    Cells(1, 8).Value = "Last Compiled On:"
    Cells(1, 9).Value = Application.WorksheetFunction.Text(Now(), "ddd dd mmm yyyy  hh:mm")
    Cells(1, 10).Value = "Testing"
    Cells(2, 2).Select
    ActiveWindow.FreezePanes = False
    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 **. If this is the case please enter ** 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
                On Error Resume Next
                Cells(R, 3).Value = f1.DateLastModified
                Select Case Err    'There is no Date recorded, found once on a pdf on a **
                    Case 1004
                        Cells(R, 3).Value = "Not Known"
                End Select
                On Error GoTo 0
                If IsCD Then
                Else
                    MaybeCD = True
                    Cells(R, 4).Value = f1.DateLastAccessed
                    MaybeCD = False
                End If
                Cells(R, 5).Value = f1.Size
                Cells(R, 7).Value = f1.DateCreated
                Cells(R, 10).Value = ownerID
            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, 8), Cells(R, 8 + N)).Interior.ColorIndex = 3
    Else
        N = 99 * Round(Cells(R, 5).Value / MaxFile, 2)
        Range(Cells(R, 8), Cells(R, 8 + N)).Interior.ColorIndex = 4
    End If
    Cells(R + 1, 5).Select
    Next R
    R = R + 1
    Cells(R, 2).Value = "Total Size in Bytes"
    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 of Files"
    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
Sub NWIntScanExtendedInfo()


End Sub
Sub OnlyLarge()
    'Short Cut = Ctrl + z
    Application.ScreenUpdating = False
    If ActiveSheet.Name = "Data" Then
        On Error GoTo Finish
        Columns("DC:DC").ClearContents
        Title = "Filter"
        Prompt = "Enter the Threshold Path Length"
        MaxP = InputBox(Prompt, Title, 255) + 0
        Prompt = "Enter the Threshold File Length"
        MaxF = InputBox(Prompt, Title, 255) + 0
        Prompt = "Enter the Threshold Path + File Length"
        MaxPF = InputBox(Prompt, Title, 255) + 0
        ActiveSheet.AutoFilterMode = False
        Rl = Cells(65536, 1).End(xlUp).Row
        For R = 2 To Rl
            Disp = False
            If Len(Cells(R, 1).Value) > MaxP Then Disp = True
            If Len(Cells(R, 2).Value) > MaxF Then Disp = True
            If Len(Cells(R, 1).Value) + Len(Cells(R, 2).Value) > MaxPF Then Disp = True
            If Disp Then Cells(R, 107).Value = 1
        Next R
        Range(Cells(1, 1), Cells(Rl, 107)).Select
        Selection.AutoFilter Field:=107, Criteria1:="1"
        Range("A1").Select
        Range(Selection, Cells(Cells(65536, 1).End(xlUp).Row, 2)).Select
        Selection.Copy
        Sheets.Add
        ActiveSheet.Name = "Large"
        Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
        Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Columns("B:B").AutoFit
        ActiveWindow.Zoom = 75
        Sheets("Data").Select
        Selection.AutoFilter Field:=107
        Columns("DC:DC").ClearContents
        Range("B2").Select
        Sheets("Large").Select
        Range("B2").Select
        ActiveWindow.FreezePanes = True
        Application.CutCopyMode = False
        Cells(1, 3).Value = "Path > " & MaxP & _
        " + File > " & MaxF & " + PathFile > " & MaxPF
    End If
Finish:
End Sub
Note that Cells(1, 10) say "Testing". This is the column where I'm trying to add each individual file's novell netware info owner. I've found some resources about how to do this, but I can't think of how the hell to apply them. BTW I do have permission to view who owns each file by right-clicking on it -> Properties -> NetWare Info Tab

[see next post]