|
|
批量写入Mp3信息_V2(标题 艺术家)的信息
从网上下载的MP3歌曲，把文件名改好了，但在播放时，却显示的是文件内置的标题，一个一个的修改吧，又太麻烦。故想通过Excel批量把MP3内的标题和艺术家读出来，修改好后再写回去。
'MP3文件格式
'MP3文件是由帧（frame）构成，帧是MP3文件的最小组成单位。
'每帧都包含帧头，并可以计算帧的长度。根据帧的性质不同，文件主要分为三个部分，ID3v2标签帧，数据帧和ID3v1标签帧。
'并非每个MP3文件都有ID3v2，但是数据帧和ID3v1帧是必须的。
'ID3v2在文件头，以字符串“ID3”为标志，包含了演唱者，作曲，专辑等信息，长度不固定，扩展了ID3V1的信息量。
'ID3v1在文件结尾，以字符串“TAG”为标记，其长度是固定的128个字节，包含了演唱者、歌名、专辑、年份等信息。
'1.ID3V2
'ID3V2到现在一共有四个版本，但流行的播放软件一般只支持第三版，既ID3V2.3。
'每个ID3V2.3 的标签都一个标签头和若干个标签帧或一个扩展标签头组成。
'关于曲目的信息如标题、作者等都存放在不同的标签帧中，扩展标签头和标签帧并不是必要的，但每个标签至少要有一个标签帧。
'标签头和标签帧一起顺序存放在MP3 文件的首部。
'标签头---------------------------------------
'长度为10个字节，位于文件首部，其数据结构如下:
'char Header[3]; /* 字符串 "ID3" */
'char Ver; /* 版本号ID3V2.3 就记录3 */
'char Revision; /* 副版本号此版本记录为0 */
'char Flag; /* 存放标志的字节，这个版本只定义了三位，很少用到，可以忽略 */
'char Size[4]; /* 标签大小，除了标签头的10 个字节的标签帧的大小 */
'标签大小为四个字节，但每个字节只用低7位，最高位不使用，恒为0，其格式如下:
'0xxxxxxx 0xxxxxxx 0xxxxxxx 0xxxxxxx
'常用帧标识:---------------------------------------
'TIT2: 标题
'TPE1: 作者
'TALB: 专辑
'TRCK: 音轨，格式:N/M，N表示专辑中第几首，M为专辑中歌曲总数
'TYER: 年份
'TCON: 类型
'COMM: 备注，格式:“eng\0备注内容”，其中eng表示所使用的语言
'帧大小为四个字节所表示的整数大小,以上顺序每一个文件都不同
'本工作表代码创建WindowsMediaPlayer对象引用了Windows Media Player(c:\windows\system32\wmp.dll)
'菜单->工具->引用->勾选口Windows Media Player
Type Mp3wj '定义用户自定义的数据类型
Name As String '全路径文件名称
Bt As String '标题
Ysj As String '艺术家
End Type
'读取MP3的ID3V2 的内容
Public Sub ReadMp3v2()
Dim Mymp3 As Mp3wj '自定义数据
Dim Mydz As String '当前工作地址
Dim Mywjm As String '文件名
Dim Myfd As FileDialog '声明一个文件对话框对象
Dim Myfso As Object, Mywjj As Object '声明一个ActiveX 对象
Dim Myranh As Integer '工作表行
Mydz = ThisWorkbook.Path '获得当前工作目录
Set Myfd = Application.FileDialog(msoFileDialogFolderPicker) '设置文件夹选择框对象
Myfd.InitialFileName = Mydz '对话框中初始显示的路径
Myfd.Title = "选择一个文件夹" '对话框中标题
Myfd.Show '显示对话框
If Myfd.SelectedItems.Count < 1 Then Exit Sub '没有选择就退出
Mydz = Myfd.SelectedItems(1) '获得选择后全路径文件夹
Set Myfso = CreateObject("Scripting.FileSystemObject") '创建并返回一个FSO对象的引用
Set Mywjj = Myfso.GetFolder(Mydz) '返回一个和指定路径中文件夹相对应的 Folder 对象
Myranh = Sheet1.Range("A65536").End(xlUp).Row '获得最后一个已使用的单元格行
If Myranh > 1 Then
If MsgBox("是否清除以前记录", 4) = 7 Then '不清除以前记录
Myranh = Myranh + 2 '如不是第一行单元格则跳下一行
Else
Sheet1.Cells.Clear '清除所有记录
Myranh = 1
End If
End If
For Each wj In Mywjj.Files '在文件夹中循环
Mywjm = wj.Path '获得全路径文件名
If UCase(Right(Mywjm, 4)) = ".MP3" Or UCase(Right(Mywjm, 4)) = ".WMA" Then '判断文件名最后4位,是否为MP3/WMA文件
Mymp3 = Dmp3v2(Mywjm) '调用函数获得Mp3v2的内容
If Mymp3.Name <> "" Then
With Sheet1 '单元格赋值
.Cells(Myranh, 1) = "文件名称"
.Cells(Myranh + 1, 1) = "标题"
.Cells(Myranh + 2, 1) = "艺术家"
.Cells(Myranh, 2) = Mymp3.Name
.Cells(Myranh + 1, 2) = Mymp3.Bt
.Cells(Myranh + 2, 2) = Mymp3.Ysj
End With
Myranh = Myranh + 4
End If
End If
Next wj
Set Myfso = Nothing
Set Mywjj = Nothing
End Sub
'调用函数读ID3V2的内容
Private Function Dmp3v2(ByVal MP3wjName As String) As Mp3wj
On Error GoTo xrerr '捕获到错误转向执行
Dim MyWmp As WindowsMediaPlayer
Dim MyMedia As IWMPMedia3 '播放器
Dim MyPlaylist As IWMPPlaylist '播放列表
Set MyWmp = New WindowsMediaPlayer
Set MyMedia = MyWmp.newMedia(MP3wjName)
With MyMedia
'For i = 0 To .attributeCount - 1 '列出所有可用属性
'Debug.Print .getAttributeName(i)
'Next
Dmp3v2.Name = MyMedia.SourceUrl '获得属性
Dmp3v2.Bt = .getItemInfo("Title") '获得属性
Dmp3v2.Ysj = .getItemInfo("Author") '获得属性
End With
Set MyWmp = Nothing
Set MyMedia = Nothing
Exit Function
xrerr:
Dmp3v2.Name = ""
Set MyWmp = Nothing
Set MyMedia = Nothing
End Function
'写入MP3的ID3v2 的内容
Public Sub WriteMp3v2()
Dim Mymp3 As Mp3wj '自定义数据
Dim Myranh As Integer, Myranh1 As Integer
If MsgBox("该操作具有一定危险性" & Chr(10) & "请先对要写入的MP3文件进行备份", 1 + 256) = 2 Then Exit Sub
Myranh = Sheet1.Range("A65536").End(xlUp).Row '获得最后一个已使用的单元格行
If Myranh < 3 Then MsgBox "工作表数据不完整": Exit Sub
If Sheet1.Cells(1, 2) = "" Then MsgBox "第一行文件名不能为空": Exit Sub
For i = 1 To Myranh Step 4
With Sheet1
Mymp3.Name = .Cells(i, 2) '自定义数据赋值
Mymp3.Bt = .Cells(i + 1, 2)
Mymp3.Ysj = .Cells(i + 2, 2)
End With
If Len(Dir(Mymp3.Name)) = 0 Then
MsgBox "没有找到 " & Mymp3.Name '判断Mp3文件是否存在
Exit For
End If
If Xmp3v2(Mymp3) = 1 Then
With Sheet1
.Cells(i, 2).Interior.ColorIndex = 3 '设置单元格底色为红
.Cells(i + 1, 2).Interior.ColorIndex = 3
.Cells(i + 2, 2).Interior.ColorIndex = 3
End With
End If
Next i
MsgBox "已完成写入"
End Sub
'调用函数读写ID3V2的内容
Private Function Xmp3v2(MP3wjName As Mp3wj) As Integer
' 返回值: 0_写错误
' 1_写正确
On Error GoTo xrerr '捕获到错误转向执行
Dim MyWmp As WindowsMediaPlayer
Dim MyMedia As IWMPMedia3 '播放器
Dim MyPlaylist As IWMPPlaylist '播放列表
Dim Myfso As Object, Mywjj As Object '声明一个ActiveX 对象
Set MyWmp = New WindowsMediaPlayer '设置一个新的对象
Set MyMedia = MyWmp.newMedia(MP3wjName.Name)
Set Myfso = CreateObject("Scripting.FileSystemObject") '创建并返回一个FSO对象的引用
Set Mywjj = Myfso.GetFile(MP3wjName.Name) '返回一个和指定路径中文件相对应的 File 对象
If Len(MP3wjName.Bt) = 0 Then MP3wjName.Bt = Left(Mywjj.Name, Len(Mywjj.Name) - 4) '标题为空用文件名赋值
With MyMedia
'For i = 0 To .attributeCount - 1 '列出所有可用属性
'Debug.Print .getAttributeName(i)
'Next
.setItemInfo "Title", MP3wjName.Bt '设定属性
.setItemInfo "Author", MP3wjName.Ysj '设定属性
End With
Xmp3v2 = 1
Set MyWmp = Nothing
Set MyMedia = Nothing
Set Mywjj = Nothing
Set Myfso = Nothing
Exit Function
xrerr:
Xmp3v2 = 0
Set MyWmp = Nothing
Set MyMedia = Nothing
Set Mywjj = Nothing
Set Myfso = Nothing
End Function
附件：
批量写入Mp3信息V2(标题 艺术家).zip
(28.86 KB, 下载次数: 462)
|
评分
-
1
查看全部评分
-
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2010-6-17 16:33
发表于 2011-2-7 15:40
