batsealine

回复 5# czjt1234


    嗯，这样是可以，不过能不能通过正则直接遍历到所有的txt文件

czjt1234

限制只读取txt文件，假定所有txt文件都是专辑

Set objFSO = CreateObject("Scripting.FileSystemObject")
set objWmp = CreateObject("WMPlayer.ocx")

strFolder = CreateObject("Wscript.Shell").CurrentDirectory & "\"
strResult = "缺少以下歌曲：" & vbCrLf & vbCrLf

Set objFolders = objFSO.GetFolder(strFolder).SubFolders
For Each objFolder In objFolders                '遍历所有歌手名
    Set objFiles = objFSO.GetFolder(objFolder).Files
    For Each objFile In objFiles                '遍历所有专辑名
        If Lcase(Split(objFile.Name, ".")(1)) = "txt" Then
            Set objTextStream = objFSO.OpenTextFile(objFile.Path, 1, False)
            strLost = ""
            Do Until objTextStream.AtEndOfStream
                strLine = Trim(objTextStream.ReadLine)
                If strLine = "" Then Exit Do    '遇到空行就认为文件已结束
                If objFSO.FileExists(strFolder & strLine & ".mp3") Then
                    Set objMp3File = objWmp.NewMedia(strFolder & strLine & ".mp3")
                    objMp3File.SetItemInfo "author", objFolder.Name
                    objMp3File.SetItemInfo "title", strLine
                    objMp3File.SetItemInfo "WM/AlbumTitle", Split(objFile.Name, ".")(0)
                Else
                    strLost = strLost & Space(8) & strLine & vbCrLf
                End If
            Loop
            If strLost <> "" Then
                strResult = strResult & objFolder.Name & vbCrLf & Space(4) & _
                            Split(objFile.Name, ".")(0) & vbCrLf & strLost & vbCrLf
            End If
        End If
    Next
Next

objFSO.OpenTextFile("result.txt", 2, True).WriteLine strResult
复制代码

batsealine

回复 2# czjt1234


    在遍历专辑文件时怎么加一个属性限制，否则若在歌手文件夹内有其它文件时会发生错误

batsealine

非常感谢，very cool

czjt1234

Set objFSO = CreateObject("Scripting.FileSystemObject")
set objWmp = CreateObject("WMPlayer.ocx")

strFolder = CreateObject("Wscript.Shell").CurrentDirectory	'指定文件夹
strResult = "缺少以下歌曲：" & vbCrLf & vbCrLf

Set objFolders = objFSO.GetFolder(strFolder).SubFolders
For Each objFolder In objFolders		'遍历所有歌手名
    Set objFiles = objFSO.GetFolder(objFolder).Files
    For Each objFile In objFiles		'遍历所有专辑名
        Set objTextStream = objFSO.OpenTextFile(objFile.Path, 1, False)
        strLost = ""
        Do Until objTextStream.AtEndOfStream
            strLine = Trim(objTextStream.ReadLine)
            If strLine = "" Then Exit Do	'容错处理，遇到空行就认为文件已结束
            If objFSO.FileExists(strFolder & "\" & strLine & ".mp3") Then
                Set objMp3File = objWmp.NewMedia(strFolder & "\" & strLine & ".mp3")
                objMp3File.SetItemInfo "author", objFolder.Name
                objMp3File.SetItemInfo "title", strLine
                objMp3File.SetItemInfo "WM/AlbumTitle", Split(objFile.Name, ".")(0)
            Else
                strLost = strLost & Space(8) & strLine & vbCrLf
            End If
        Loop
        If strLost <> "" Then
            strResult = strResult & objFolder.Name & vbCrLf & Space(4) & _
                        Split(objFile.Name, ".")(0) & vbCrLf & strLost & vbCrLf
        End If
    Next
Next

objFSO.OpenTextFile("result.txt", 2, True).WriteLine strResult
复制代码