Excel VBA - 捕獲文件屬性和所有者詳細信息

我不是VBA的專家，所以我希望有人可以提供幫助。Excel 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

來源

2017-01-27 Punkrock760

沒有重構它，如果你改變這行代碼;

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

對此;

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

它會調用GetFileOwner函數，並應該爲你做。

來源

2017-01-27 15:53:52

Excel VBA - 捕獲文件屬性和所有者詳細信息

回答

相關問題