获取磁盘上文件的所有者

时间:2015-04-14 15:24:39

标签: excel vba

下面是我当前的宏,它工作得很好,但我想在单元格(r,10)中添加文件的所有者。怎么能完成这样的事情?我无法找到像File.Owner之类的命令。

Sub DoFolder(Folder)
If Ans = vbNo Then GoTo NoSub                                           'Switching according to ans.
Dim SubFolder
For Each SubFolder In Folder.SubFolders
    DoFolder SubFolder
Next
NoSub:
Dim File
For Each File In Folder.Files
    FName = File.Name
    If InStrRev(FName, ".") = 0 Then GoTo NextFile                      'If "." not found then go to next file
    Cells(r, 1) = Left(FName, InStrRev(FName, ".") - 1)                 'File Name
    ActiveSheet.Hyperlinks.Add Anchor:=Cells(r, 2), _
                               Address:=File.Path, _
                               TextToDisplay:=File.Path                 'Hyperlinking Path
    Cells(r, 3) = File.DateLastModified                                 'Date Last Modified
    Cells(r, 4) = Round(File.Size / 1024, 3)                            'in KBs Rounded to 3 Decimal places
    Cells(r, 5) = Right(FName, Len(FName) - InStrRev(FName, ".") + 1)   'File Extension
    r = r + 1
NextFile:
Next
End Sub

1 个答案:

答案 0 :(得分:1)

您可以通过Security Utility对象访问文件的安全属性(其中一个是所有者)。

Option Explicit

Sub test()
    Dim fName As String
    Dim fDir As String
    fName = "test.txt"
    fDir = "C:\Temp\"
    Debug.Print "The owner is " & GetFileOwner(fDir, fName)
End Sub

Function GetFileOwner(fileDir As String, fileName As String) As String
    Dim securityUtility As Object
    Dim securityDescriptor As Object
    Set securityUtility = CreateObject("ADsSecurityUtility")
    Set securityDescriptor = securityUtility.GetSecurityDescriptor(fileDir & fileName, 1, 1)
    GetFileOwner = securityDescriptor.owner
End Function