如何用VBA将Windows目录中音乐文件属性导入Excel？

核心思路 #

VBA自带的Dir函数仅能获取文件名，要读取音乐文件的元数据（如标题、艺术家、年份等），需借助Shell.Application对象访问文件的扩展属性。以下是修改后的完整代码，可批量提取指定目录下音乐文件的目标属性。

完整VBA代码 #

Sub GetMusicFileProperties()
    Dim fileDirectory As String
    Dim fileName As String
    Dim shellApp As Object
    Dim folderObj As Object
    Dim fileObj As Object
    Dim i As Integer
    
    ' 设置目标音乐目录
    fileDirectory = "D:\Sound\Jazz & Blues\"
    ' 初始化Shell对象用于读取文件属性
    Set shellApp = CreateObject("Shell.Application")
    Set folderObj = shellApp.Namespace(fileDirectory)
    
    ' 设置表头（A到H列）
    Range("A1").Value = "序号"
    Range("B1").Value = "文件名"
    Range("C1").Value = "Title"
    Range("D1").Value = "Contributing Artists"
    Range("E1").Value = "Album"
    Range("F1").Value = "Year"
    Range("G1").Value = "Length"
    Range("H1").Value = "Date Modified"
    
    i = 2
    fileName = Dir(fileDirectory)
    
    Do While Len(fileName) > 0
        Set fileObj = folderObj.ParseName(fileName)
        
        ' 写入序号与文件名
        Range("A" & i).Value = i - 1
        Range("B" & i).Value = fileName
        
        ' 读取并写入各音乐属性
        Range("C" & i).Value = GetExtendedProperty(folderObj, fileObj, "Title")
        Range("D" & i).Value = GetExtendedProperty(folderObj, fileObj, "Contributing Artists")
        Range("E" & i).Value = GetExtendedProperty(folderObj, fileObj, "Album")
        Range("F" & i).Value = GetExtendedProperty(folderObj, fileObj, "Year")
        Range("G" & i).Value = GetExtendedProperty(folderObj, fileObj, "Length")
        ' 直接通过FileDateTime获取文件修改时间
        Range("H" & i).Value = FileDateTime(fileDirectory & fileName)
        
        i = i + 1
        fileName = Dir
    Loop
    
    ' 释放对象避免内存占用
    Set fileObj = Nothing
    Set folderObj = Nothing
    Set shellApp = Nothing
    
    ' 自动调整列宽优化显示
    Columns("A:H").AutoFit
End Sub

' 辅助函数：根据属性名称获取文件扩展属性值
Function GetExtendedProperty(folder As Object, file As Object, propName As String) As String
    Dim propIndex As Integer
    propIndex = -1
    
    ' 遍历系统属性列表，匹配目标属性的索引
    Do While folder.GetDetailsOf(folder.Items, propIndex + 1) <> ""
        propIndex = propIndex + 1
        If folder.GetDetailsOf(folder.Items, propIndex) = propName Then
            GetExtendedProperty = folder.GetDetailsOf(file, propIndex)
            Exit Function
        End If
    Loop
    
    ' 未找到目标属性时返回空字符串
    GetExtendedProperty = ""
End Function

代码说明 #

• Shell.Application对象：调用Windows Shell的文件系统能力，实现对文件元数据的读取。
• 辅助函数GetExtendedProperty：通过遍历属性名称匹配索引，避免因系统语言差异导致的属性索引不一致问题。
• FileDateTime函数：直接获取文件修改时间，无需依赖Shell属性读取。
• 表头与列宽调整：预先设置表头并自动调整列宽，提升数据可读性。

使用注意事项 #

• 确保目标目录路径正确，结尾需保留反斜杠\。
• FLAC等格式的属性读取依赖系统解码器，若系统未安装对应组件，可能无法获取部分属性。
• 运行前需在Excel中启用宏功能。

内容的提问来源于stack exchange，提问作者KKB