|
Если Вы являетесь обладателем коллекции mp3 файлов и хотите с помощью
MS Excel и VBA создать перечень или каталог, содержащий как имена
музыкальных файлов, так и значения некоторых их свойств, к примеру,
Исполнитель, Альбом, Номер записи, Время звучания (длительность),
Качество звука и т.д., то для решения поставленной задачи можно
воспользоваться Windows XP (или старше) и об'ектом Shell
| Private Sub CreateReport_Mp3FileProperties()
Dim iFileName$, iPath$, iRow&, iColumn&
Dim iFolder As Object, iMp3File As Object
iPath = "C:\Мои документы\Downloads\mp3_tracks\": iRow = 2
Set iFolder = CreateObject("Shell.Application").NameSpace(CVar(iPath))
If Not iFolder Is Nothing Then
iFileName = Dir(iPath & "*.mp3")
If iFileName <> "" Then
Workbooks.Add xlWBATWorksheet
Application.ScreenUpdating = False
Do
Application.StatusBar = iFileName
Set iMp3File = iFolder.ParseName(iFileName)
For iColumn = 0 To 50 '
Cells(iRow, iColumn + 1) = iFolder.GetDetailsOf(iMp3File, iColumn)
Next
iFileName = Dir
iRow = iRow + 1
Loop While iFileName <> ""
For iColumn = 0 To 50 ' Headers Report
Cells(1, iColumn + 1) = iFolder.GetDetailsOf(iFolder.Items, iColumn)
Next
Application.StatusBar = False
Application.ScreenUpdating = True
Else
MsgBox "Нет музыкальных файлов .mp3", , ""
End If
Else
MsgBox "Папка, а стало быть и файл(ы), отсутствуют", , ""
End If
End Sub |
| Private Sub CreateReport_Mp3FileProperties2()
Dim iPath$, iMp3Property$(), iCountFiles&, iRow&, iColumn&
Dim iFolder As Object, iFolderItems As Object, iMp3File As Object
iPath = "C:\Мои документы\Downloads\mp3_tracks"
Set iFolder = CreateObject("Shell.Application").NameSpace((iPath))
If Not iFolder Is Nothing Then
Set iFolderItems = iFolder.Items
iFolderItems.Filter 64 + 128, "*.mp3"
iCountFiles = iFolderItems.Count
If iCountFiles > 0 Then
ReDim iMp3Property(iCountFiles - 1, 50)
Application.ScreenUpdating = False
Workbooks.Add xlWBATWorksheet
For iColumn = 0 To 50 ' Headers Report
Cells(1, iColumn + 1) = iFolder.GetDetailsOf(iFolderItems, iColumn)
Next
For Each iMp3File In iFolderItems
Application.StatusBar = iMp3File.Name
For iColumn = 0 To 50 '
iMp3Property(iRow, iColumn) = iFolder.GetDetailsOf(iMp3File, iColumn)
Next
iRow = iRow + 1
Next
Cells(2, 1).Resize(iCountFiles, 51).Value = iMp3Property
Application.StatusBar = False
Application.ScreenUpdating = True
Else
MsgBox "Нет музыкальных файлов .mp3", , ""
End If
Else
MsgBox "Папка, а стало быть и файл(ы), отсутствуют", , ""
End If
End Sub |
Теперь, если Вы правильно указали папку с mp3 файлами, то в результате
выполнения любого из вышеопубликованных макросов, Вы сможете узнать какие
именно номера столбцов = iColumn позволят получить значения необходимых
свойств GetDetailsOf(vItem, iColumn As Long)
К сожалению, нет
никакой гарантии, что на компьютере с другой конфигурацией, используя
полученные номера столбцов, Вы получите аналогичные результаты, так что,
решайте сами, стоит ли рисковать и использовать данный способ или нет.
Вариант II. Другой способ получения нужной информации,
заключается в использовании метода ExtendedProperty . Более
подробную информацию об этом методе, можно найти на
официальном сайте. От себя лишь добавлю небольшую таблицу SCID

| Private Sub CreateReport_Mp3FileProperties4()
Dim iArrProp As Variant, iValueProp As Variant, iRow&, iColumn&
Dim iPath As Variant, iFileName$, iFolder As Object, iMp3File As Object
iArrProp = Array( _
"DocTitle", "Artist", "Album", "Year", "Track", "Genre", _
"Duration", "Bitrate", "Sample Rate", "Channels", "DocComments", "Protected")
Application.ScreenUpdating = False: Workbooks.Add xlWBATWorksheet
iPath = "C:\Downloads\Music\MP3\" 'Укажите свою папку с .mp3 файлами
Set iFolder = CreateObject("Shell.Application").NameSpace(iPath)
iFileName = Dir(iPath & "*.mp3"): iRow = 2
Do Until iFileName = ""
Set iMp3File = iFolder.ParseName(iFileName)
Application.StatusBar = iFileName: Cells(iRow, 1) = iFileName
For iColumn = 0 To 11 'UBound(iArrProp)
iValueProp = iMp3File.ExtendedProperty(iArrProp(iColumn))
Select Case iColumn
Case 7, 8
Cells(iRow, iColumn + 2) = iValueProp \ 1000
Case 6
Cells(iRow, iColumn + 2) = Format(CDbl(iValueProp) / 864000000000#, "hh:mm:ss")
Case Else
Cells(iRow, iColumn + 2) = iValueProp
End Select
Next
iFileName = Dir: iRow = iRow + 1
Loop
With Cells(1).Resize(, 13) 'Range("A1:M1")
.Value = Array( _
"Имя файла", "Заголовок", "Исполнитель", "Aльбом", "Год", _
"Номер записи", "Жанр", "Длительность", "Качество звука (кбит/сек)", _
"Частота дискретизации (кГц)", "Каналы", "Комментарий", "Защита")
.Font.Bold = True: .EntireColumn.AutoFit
End With
Application.StatusBar = False
Application.ScreenUpdating = True
End Sub |
Автор :
Климов Павел Юрьевич
|
|
© 2004-2016 Климов П.Ю. Все права защищены. |
WebDesign & Error's
Klimoff
|