Excel 获取磁盘上文件的所有者

下面是我当前的宏，它工作得很好，但我想添加单元格（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

---

您可以通过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

---

我建议将函数复制到您的modeule中，然后在

r=r+1

之前添加一行

Cells（r，10）=GetFileOwner（Folder.FolderPath，FName）

。我没有尝试运行您的代码，因为您的大多数变量都没有定义（将

Option Explicit

放在模块顶部），而且它看起来是递归的。