Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.word.docmanagement
|
|||
|
|||
How to generate the file atribute:"owner" of a file
Hey guys
I have made a list of filenames of all files in a folder. I manage this (by some help from my friends) I have allocated some file attributes; arFiles(0, cnt) = Folder.path arFiles(1, cnt) = file.Name arFiles(2, cnt) = Format(file.DateLastAccessed, "yyyy.mm.dd hh:mm") arFiles(3, cnt) = file.Size and I really should complete the information with "file.owner" - but I cant get through this... Here is the essence of my macro-system: '----------------------------------------------------------------------- Sub Folders() '----------------------------------------------------------------------- On Error Resume Next Sheets("All3DModel").Delete If Err.Number 0 Then On Error GoTo 0 End If Dim Folder As String Folder = 6 Folder = Trim(Folder) Dim i As Long Set FSO = CreateObject("Scripting.FileSystemObject") arFiles = Array() cnt = 0 level = 1 ReDim arFiles(3, 0) arFiles(0, 0) = Worksheets(1).Range("A" & Folder) If arFiles(0, 0) "" Then res = ThisWorkbook.Worksheets("Board").Range("A8").Value res = Trim(res) arFiles(1, 0) = level SelectFiles arFiles(0, 0) Worksheets.Add.Name = "All3DModel" With ActiveSheet .Cells(1, 1).Value = "Path" .Cells(1, 2).Value = "FileName" .Cells(1, 3).Value = "LastAccessed" .Cells(1, 4).Value = "Size" .Cells(1, 5).Value = "Owner" 'Header is ok, but my macro will not generate the actual value .Rows(1).Font.Bold = True .Columns(4).NumberFormat = "#,##0 "" KB""" cnt = 1 For i = LBound(arFiles, 2) To UBound(arFiles, 2) .Cells(i + 2, 1).Value = arFiles(0, i) .Cells(i + 2, 2).Value = arFiles(1, i) .Cells(i + 2, 3).Value = arFiles(2, i) .Cells(i + 2, 4).Value = arFiles(3, i) / 1024 ' I think the "owner"-stuff should be placed somewhere like this ActiveSheet.Hyperlinks.Add Anchor:=.Cells(i + 2, 2), Address:=arFiles(0, i) & "\" & arFiles(1, i) Next .Columns("A").EntireColumn.AutoFit End With End If End Sub '----------------------------------------------------------------------- Sub SelectFiles(ByVal sPath) '----------------------------------------------------------------------- Dim fldr As Object Dim Folder As Object Dim file As Object Dim Files As Object Set Folder = FSO.GetFolder(sPath) Set Files = Folder.Files For Each file In Files If (file.Attributes And 2 Or file.Attributes And 4) Then ' Else If InStr(1, file.Name, res, vbTextCompare) 0 Then cnt = cnt + 1 ReDim Preserve arFiles(3, cnt) arFiles(0, cnt) = Folder.path arFiles(1, cnt) = file.Name arFiles(2, cnt) = Format(file.DateLastAccessed, "yyyy.mm.dd hh:mm") arFiles(3, cnt) = file.Size ' I think the "owner"-stuff should be placed somewhere like this too End If End If Next file level = level + 1 For Each fldr In Folder.Subfolders SelectFiles fldr.path Next End Sub '------------------------------------------------------------- Function GetFolder(Optional ByVal _ Name As String = "Select a folder.") _ As String '------------------------------------------------------------- ' I dont no if this have any significance to my problem Dim bInfo As BROWSEINFO Dim path As String Dim oDialog As Long bInfo.pidlRoot = 0& bInfo.lpszTitle = Name bInfo.ulFlags = &H1 oDialog = SHBrowseForFolder(bInfo) path = Space$(512) GetFolder = "" If SHGetPathFromIDList(ByVal oDialog, ByVal path) Then GetFolder = Left(path, InStr(path, Chr$(0)) - 1) End If End Function |
Reply |
Thread Tools | |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
"Page Setup" under the "File" menu is disabled; I can't change mar | Page Layout | |||
After mail merge, "File format is not valid" error when opening XLS file | Mailmerge | |||
eliminate "copy" of "saved as" document showing up in file list | Microsoft Word Help | |||
Folder or file details pop-up in "save" or "open" dialog boxes. | Microsoft Word Help | |||
Cannot print "For Sale by Owner" template. | Page Layout |