Question

我不是VBA的专家，所以我希望有人可以提供帮助。

我有两个VBA代码。一个循环遍历并打印文件属性，另一个抓取文件的所有者。我想将文件所有者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

文件所有者 - 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

Answer 1

如果不改编，可以改变这行代码;

Application.ActiveSheet.Cells(rowIndex, 8).Formula = xFile.Owner

对此;

Application.ActiveSheet.Cells(rowIndex, 8).Formula = GetFileOwner(xFolderName, xFile.Name)

它会调用GetFileOwner函数，并且应该为你做这个技巧。

Excel VBA - 捕获文件属性和所有者详细信息

1 个答案: