获取磁盘上文件的所有者

Question

下面是我当前的宏，它工作得很好，但我想在 Cells（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

Answer 1

您可以通过安全实用程序对象访问文件的安全属性（其中一个是所有者）。

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