VBA-获取所有文件属性

我想获取文件夹中所有文件的属性。我已经将其用于固定数量的属性，我唯一关心的是找到最后一个属性的索引，用于GetDetailsOf方法，以便我可以列出所有属性。

下面的函数返回属性计数，但不正确，因为它基于最后一个非空属性名称。然而，有一些索引的名称为空（不确定它们是否可以有值），后面跟着另一个索引，其属性名称具有普通字符串。

我也尝试过On Error Resume Next错误表明最后一个索引已被使用，但从未出现错误，并且显然导致了无限循环GetDetailsOf将接受每个 long >=0。

我还想知道一台计算机上每个文件夹的文件属性数量是否相同。

编辑：我可能没有清楚地表达它，我想要的是获取最后一个属性名称的索引，以便我可以检查所有现有属性的值。

编辑2：这是我的文件的链接，列出了所选文件夹和所有级别的子文件夹中所有文件的属性。可能存在一些未处理的错误（我已经用快捷方式对导致宏崩溃的错误进行了排序），我想到了 Windows 路径长度限制，但它通常适用于选定的文件夹。

感兴趣的主要函数是 list_properties 模块中的 CountProperties。它决定将返回多少属性列。

https://drive.google.com/open?id=1TRIZJoGnHXs9LJtxDBj9rp27ngkects- https://drive.google.com/open?id=1TRIZJoGnHXs9LJtxDBj9rp27ngkects-

Function CountProperties(ByRef FldPath) As Long

Dim objShell As Object
Dim objFolder As Object
Dim testStr As String
Dim propertyCnt As Long

Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(Left(FldPath, Len(FldPath) - 1)) 'no slash in the end

Do
    testStr = vbNullString      
    testStr = objFolder.GetDetailsOf(objFolder.Items, propertyCnt)      
    If testStr = vbNullString Then Exit Do
    propertyCnt = propertyCnt + 1
Loop

CountProperties = propertyCnt

End Function

我不完全清楚其最终目标是什么，但以下内容应该提取您需要的所有信息。

包括：按文件列出的设置属性总数、设置属性的文件夹计数、每个文件的扩展属性值以及文件夹中的所有文件是否具有相同数量的已分配属性值。我可能会重新考虑该功能，但等待您的反馈。

Note:

我选择返回一个数组，因为我认为您可能最终会比较文件夹，这样您就可以使用文件夹路径作为键简单地创建返回数组的集合/字典。然后，您可以跨文件夹访问和比较数组中的项目。

Code:

Option Explicit

''******************************************************************
'' folderInfo returns:
'' folderInfo(0) = PATH_FOLDER - folder path used
'' folderInfo(1) = AllFileProperties - Dictionary of arrays containing all the file properties of each file within the folder
'' folderInfo(2) = totalPropertiesSetInFolder - total count of extended properties <> vbNullString in the folder
'' folderInfo(3) = filePropertyCounts - dictionary of each file with its respective set property count
'' folderInfo(4) = AllFilesHaveSamePropertyCount - Boolean to say if all files in folder have same # extended properties set

''******************************************************************
Public Sub test()

    Const PATH_FOLDER As String = "C:\Users\User\Desktop\TestFolder\"
    Dim resultsArray()
    resultsArray() = folderInfo(PATH_FOLDER) '<== All the info is now returned here

''***************************************************************************************
       '' Examples of extracting the retrieved information from the array

''***************************************************************************************    

    'Example: folderInfo(0) = folderPath
    Debug.Print "Folderpath = " & resultsArray(0)
    Debug.Print String$(20, Chr$(60))
    Debug.Print vbNewLine

''***************************************************************************************

    'Example: folderInfo(1) = AllFileProperties
    Debug.Print "AllFileProperties:"
    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")
    Set dict = resultsArray(1)

    Dim key As Variant, arr(), i As Long

    For Each key In dict.keys
        Debug.Print "FileName = " & key
        arr() = dict(key)
        For i = LBound(arr, 1) To UBound(arr, 1)
            Debug.Print arr(i, 1), arr(i, 2)
        Next i

        Debug.Print String$(20, Chr$(60))
        Debug.Print vbNewLine
    Next key

''***************************************************************************************

    ''Example: folderInfo(2) = totalPropertiesSetInFolder
    MsgBox "Total properties set in folder = " & resultsArray(2)


''***************************************************************************************

    ''Example: folderInfo(3) = filePropertyCounts
    Dim dict2 As Object
    Set dict2 = CreateObject("Scripting.Dictionary")
    Set dict2 = resultsArray(3)

    Dim key2 As Variant

    For Each key2 In dict2.keys
        Debug.Print key2 & " set property count = " & dict2(key2)
    Next key2

''***************************************************************************************
    ''Example: folderInfo(4) = AllFilesHaveSamePropertyCount
    MsgBox "All files have the same # of set properties? = " & resultsArray(4)

End Sub

Public Function folderInfo(ByVal PATH_FOLDER As String) As Variant

    Dim objShell As Object
    Dim objFolder As Object

    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.Namespace(Left$(PATH_FOLDER, Len(PATH_FOLDER) - 1))

    'Retrieving Extended File Properties
    Dim i As Long
    Dim arrHeaders(35)

    For i = 0 To 34
        arrHeaders(i) = objFolder.GetDetailsOf(objFolder.items, i)
    Next

    Dim fileName As Object, setPropertyCount As Long, filePropertyCounts As Object, totalPropertiesSetInFolder As Long
    Set filePropertyCounts = CreateObject("Scripting.Dictionary")
    Dim AllFileProperties As Object
    Set AllFileProperties = CreateObject("Scripting.Dictionary")

    For Each fileName In objFolder.items
        setPropertyCount = 0
        Dim fileProperties(0 To 35, 0 To 35)
        fileProperties(0, 0) = fileName
        For i = 0 To 34
            If objFolder.GetDetailsOf(fileName, i) <> vbNullString Then setPropertyCount = setPropertyCount + 1
             fileProperties(i + 1, 1) = arrHeaders(i)
             fileProperties(i + 1, 2) = objFolder.GetDetailsOf(fileName, i)

            '            Debug.Print i & vbTab & arrHeaders(i) _
            '                      & ": " & objFolder.GetDetailsOf(fileName, i)
            '            Debug.Print vbNewLine
        Next i
        'Debug.Print fileName & ": setpropertyCount = " & setPropertyCount
        filePropertyCounts.Add fileName.Name, setPropertyCount

        AllFileProperties.Add fileName.Name, fileProperties
    Next fileName

    totalPropertiesSetInFolder = Application.WorksheetFunction.Sum(filePropertyCounts.items)

    folderInfo = Array(PATH_FOLDER, AllFileProperties, totalPropertiesSetInFolder, filePropertyCounts, AllFilesHaveSamePropertyCount(filePropertyCounts))

End Function

Public Function AllFilesHaveSamePropertyCount(ByVal filePropertyCounts As Object) As Boolean

    AllFilesHaveSamePropertyCount = True
    Dim key As Variant

    For Each key In filePropertyCounts.Keys
        If filePropertyCounts(key) <> Application.WorksheetFunction.Max(filePropertyCounts.items) Then
            AllFilesHaveSamePropertyCount = False
            Exit Function
        End If
    Next key

End Function

运行示例：

参考：

https://technet.microsoft.com/en-us/library/ee176615.aspx https://technet.microsoft.com/en-us/library/ee176615.aspx