返回列表 发帖
czjt1234

Rank: 6Rank: 6

帖子
1127 
积分
1648 
技术
117  
捐助
0  
注册时间
2010-4-30 
1楼 跳转到 »
发表于 2013-5-3 17:28 | 显示全部帖子 
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 strResultCOPY
1

评分人数


QQ 20147578

TOP

czjt1234

Rank: 6Rank: 6

帖子
1127 
积分
1648 
技术
117  
捐助
0  
注册时间
2010-4-30 
2楼
发表于 2013-5-5 16:59 | 显示全部帖子
本帖最后由 czjt1234 于 2013-5-5 17:00 编辑

限制只读取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 strResultCOPY

QQ 20147578

TOP

czjt1234

Rank: 6Rank: 6

帖子
1127 
积分
1648 
技术
117  
捐助
0  
注册时间
2010-4-30 
3楼
发表于 2013-5-6 06:37 | 显示全部帖子
什么意思~~~~~

QQ 20147578

TOP

czjt1234

Rank: 6Rank: 6

帖子
1127 
积分
1648 
技术
117  
捐助
0  
注册时间
2010-4-30 
4楼
发表于 2013-5-6 15:23 | 显示全部帖子
fso对象没这个功能

可以考虑Wscript.Shell对象运行cmd命令dir *.txt /a/b

然后读取输出的内容

不过没有必要吧，读取全部文件再判断是否是txt也不影响速度

QQ 20147578

TOP

czjt1234

Rank: 6Rank: 6

帖子
1127 
积分
1648 
技术
117  
捐助
0  
注册时间
2010-4-30 
5楼
发表于 2013-5-6 19:45 | 显示全部帖子
你是担心这个啊

没问题的

QQ 20147578

TOP

czjt1234

Rank: 6Rank: 6

帖子
1127 
积分
1648 
技术
117  
捐助
0  
注册时间
2010-4-30 
6楼
发表于 2013-5-6 23:29 | 显示全部帖子
啊，惭愧惭愧，考虑不周

这样

If Lcase(Right(objFile.Name, 3)) = "txt" Then

QQ 20147578

TOP

czjt1234

Rank: 6Rank: 6

帖子
1127 
积分
1648 
技术
117  
捐助
0  
注册时间
2010-4-30 
7楼
发表于 2013-5-6 23:33 | 显示全部帖子
本帖最后由 czjt1234 于 2013-5-6 23:37 编辑 
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(Right(objFile.Name, 3)) = "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", Left(objFile.Name, Len(objFile.Name) - 4)
                Else
                    strLost = strLost & Space(8) & strLine & vbCrLf
                End If
            Loop
            If strLost <> "" Then
                strResult = strResult & objFolder.Name & vbCrLf & Space(4) & _
                            Left(objFile.Name, Len(objFile.Name) - 4) & vbCrLf & strLost & vbCrLf
            End If
        End If
    Next
Next
 
objFSO.OpenTextFile("result.txt", 2, True).WriteLine strResultCOPY

QQ 20147578

TOP

返回列表