excel - VBA - 获取所有文件属性

Question

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

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

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

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

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

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

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

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

Answer 1

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

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

注:

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

代码:

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