Excel VBA – 捕获文件属性和所有者详细信息
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/41897239/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Excel VBA – Capture File Properties and Owner Details
提问by Punkrock760
I'm no expert with VBA so I'm hoping someone can help.
我不是 VBA 专家，所以我希望有人可以提供帮助。
I have two VBA codes. One loops through and prints the file properties, and the other grabs the owner of a file. I want to merge the File Owner VBA code into File Properties to be able to print the file name, modification date and owner onto a sheet.
我有两个 VBA 代码。一个循环并打印文件属性，另一个获取文件的所有者。我想将文件所有者 VBA 代码合并到文件属性中，以便能够将文件名、修改日期和所有者打印到工作表上。
I can't figure out how to merge the two set of codes together, can somebody please help?
我不知道如何将两组代码合并在一起，有人可以帮忙吗？
It looks like it can be possible to achieve but I'm hitting a barrier and I can't find a solution online.
看起来可以实现，但我遇到了障碍，我无法在网上找到解决方案。
File Properties - VBA
文件属性 - VBA
Sub MainList()
Application.ScreenUpdating = True
Set Folder = Application.FileDialog(msoFileDialogFolderPicker)
If Folder.Show <> -1 Then Exit Sub
xDir = Folder.SelectedItems(1)
Call ListFilesInFolder(xDir, True)
Application.ScreenUpdating = False
End Sub
Sub ListFilesInFolder(ByVal xFolderName As String, ByVal xIsSubfolders As Boolean)
Application.ScreenUpdating = True
Dim xFileSystemObject As Object
Dim xFolder As Object
Dim xSubFolder As Object
Dim xFile As Object
Dim rowIndex As Long
Set xFileSystemObject = CreateObject("Scripting.FileSystemObject")
Set xFolder = xFileSystemObject.GetFolder(xFolderName)
rowIndex = Application.ActiveSheet.Range("A65536").End(xlUp).Row + 1
For Each xFile In xFolder.Files
Application.ActiveSheet.Cells(rowIndex, 1).Formula = xFile.Path
Application.ActiveSheet.Cells(rowIndex, 2).Formula = xFile.Name
Application.ActiveSheet.Cells(rowIndex, 3).Formula = xFile.DateLastAccessed
Application.ActiveSheet.Cells(rowIndex, 4).Formula = xFile.DateLastModified
Application.ActiveSheet.Cells(rowIndex, 5).Formula = xFile.DateCreated
Application.ActiveSheet.Cells(rowIndex, 6).Formula = xFile.Type
Application.ActiveSheet.Cells(rowIndex, 7).Formula = xFile.Size
Application.ActiveSheet.Cells(rowIndex, 8).Formula = xFile.Owner
ActiveSheet.Cells(2, 9).FormulaR1C1 = "=COUNTA(C[-7])"
rowIndex = rowIndex + 1
Next xFile
If xIsSubfolders Then
For Each xSubFolder In xFolder.SubFolders
ListFilesInFolder xSubFolder.Path, True
Next xSubFolder
End If
Set xFile = Nothing
Set xFolder = Nothing
Set xFileSystemObject = Nothing
Application.ScreenUpdating = False
End Sub
File Owner - VBA
文件所有者 - VBA
Sub test()
Dim fName As String
Dim fDir As String
fName = "FileName.JPG"
fDir = "C:/FilePath"
Range("A1").Value = 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
回答by Old Nick
Without refactoring it, if you change this line of code;
不重构它，如果你改变这行代码；
Application.ActiveSheet.Cells(rowIndex, 8).Formula = xFile.Owner
To this;
对此；
Application.ActiveSheet.Cells(rowIndex, 8).Formula = GetFileOwner(xFolderName, xFile.Name)
It will call the GetFileOwner function and should do the trick for you.
它将调用 GetFileOwner 函数，并且应该为您解决问题。
