Option Explicit '引用Microsoft Scripting RunTime Dim m_objFSO As New FileSy<a href="https://www.jb51.cc/tag/stem/" target="_blank" class="keywords">stem</a>Object '定义<a href="https://www.jb51.cc/tag/wenjian/" target="_blank" class="keywords">文件</a>系统对象 Private Declare Function SHGetSpecialFolderLocation Lib "Shell32" (ByVal hwndOwner As Long,ByVal nFolder As Integer,ppidl As Long) As Long Private Declare Function SHGetPathFromIDList Lib "Shell32" Alias "SHGetPathFromIDListA" (ByVal pidl As Long,ByVal szPath As String) As Long Const MAX_LEN = 200 '字符串最大长度 Const PAGETMP = &H20& '网页临时<a href="https://www.jb51.cc/tag/wenjian/" target="_blank" class="keywords">文件</a> Private Sub Command1_Click() Dim sTmp As String * MAX_LEN '存放结果的固定长度的字符串 Dim nLength As Long '字符串的实际长度 Dim pidl As Long '某特殊目录在特殊目录列表中的位置 Dim TStr As String '获得网页临时<a href="https://www.jb51.cc/tag/wenjian/" target="_blank" class="keywords">文件</a>夹 SHGetSpecialFolderLocation 0,PAGETMP,pidl SHGetPathFromIDList pidl,sTmp TStr = Left(sTmp,InStr(sTmp,Chr(0)) - 1) SearchMP3 TStr End Sub Private Sub SearchMP3(strPath As String) Dim objFolder As Scripting.Folder '<a href="https://www.jb51.cc/tag/wenjian/" target="_blank" class="keywords">文件</a>夹对象 Dim objFile As Scripting.File '<a href="https://www.jb51.cc/tag/wenjian/" target="_blank" class="keywords">文件</a>对象 Dim objSubd<a href="https://www.jb51.cc/tag/irs/" target="_blank" class="keywords">irs</a> As Scripting.Folders '<a href="https://www.jb51.cc/tag/wenjian/" target="_blank" class="keywords">文件</a>夹集合对象 Dim objLoopFolder As Scripting.Folder '<a href="https://www.jb51.cc/tag/wenjian/" target="_blank" class="keywords">文件</a>夹对象 Set objFolder = m_objFSO.GetFolder(strPath) For Each objFile In objFolder.Files If LCase$(Right$(objFile.ShortPath,4)) = ".mp3" Then File<a href="https://www.jb51.cc/tag/cop/" target="_blank" class="keywords">cop</a>y objFile.Path,"c:/TestMP3/" & UTF8Decode(objFile.Name) End If Next objFile Set objSubd<a href="https://www.jb51.cc/tag/irs/" target="_blank" class="keywords">irs</a> = objFolder.SubFolders For Each objLoopFolder In objSubd<a href="https://www.jb51.cc/tag/irs/" target="_blank" class="keywords">irs</a> SearchMP3 objLoopFolder.Path Next objLoopFolder Set objSubd<a href="https://www.jb51.cc/tag/irs/" target="_blank" class="keywords">irs</a> = <a href="https://www.jb51.cc/tag/nothing/" target="_blank" class="keywords">nothing</a> Set objFolder = <a href="https://www.jb51.cc/tag/nothing/" target="_blank" class="keywords">nothing</a> End Sub Public Function UTF8Decode(ByVal code As String) As String If code = "" Then UTF8Decode = "" Exit Function End If Dim tmp As String Dim decodeStr As String Dim codelen As Long Dim result As String Dim leftStr As String leftStr = Left(code,1) While (code <> "") codelen = Len(code) leftStr = Left(code,1) If leftStr = "%" Then If (Mid(code,2,1) = "C" Or Mid(code,1) = "B") Then decodeStr = Replace(Mid(code,1,6),"%","") tmp = c10ton(Val("&H" & Hex(Val("&H" & decodeStr) And &H1F3F))) tmp = String(16 - Len(tmp),"0") & tmp UTF8Decode = UTF8Decode & UTF8Decode & ChrW(Val("&H" & c2to16(Mid(tmp,3,4)) & c2to16(Mid(tmp,7,2) & Mid(tmp,11,2)) & Right(decodeStr,1))) code = Right(code,codelen - 6) ElseIf (Mid(code,1) = "E") Then decodeStr = Replace(Mid(code,9),"") tmp = c10ton((Val("&H" & Mid(Hex(Val("&H" & decodeStr) And &HF3F3F),3)))) tmp = String(10 - Len(tmp),"0") & tmp UTF8Decode = UTF8Decode & ChrW(Val("&H" & (Mid(decodeStr,1) & c2to16(Mid(tmp,5,2) & Right(tmp,1)))) code = Right(code,codelen - 9) End If Else UTF8Decode = UTF8Decode & leftStr code = Right(code,codelen - 1) End If Wend End Function '10进制转n进制(<a href="https://www.jb51.cc/tag/mo/" target="_blank" class="keywords">默</a>认2) Public Function c10ton(ByVal x As Integer,Optional ByVal n As Integer = 2) As String Dim i As Integer i = x / n If i > 0 Then If x Mod n > 10 Then c10ton = c10ton(i,n) + Chr(x Mod n + 55) Else c10ton = c10ton(i,n) + CStr(x Mod n) End If Else If x > 10 Then c10ton = Chr(x + 55) Else c10ton = CStr(x) End If End If End Function '二进制<a href="https://www.jb51.cc/tag/daimazhuanhuan/" target="_blank" class="keywords">代码转换</a>为十六进制<a href="https://www.jb51.cc/tag/daima/" target="_blank" class="keywords">代码</a> Public Function c2to16(ByVal x As String) As String Dim i As Long i = 1 For i = 1 To Len(x) Step 4 c2to16 = c2to16 & Hex(c2to10(Mid(x,i,4))) Next End Function '二进制<a href="https://www.jb51.cc/tag/daimazhuanhuan/" target="_blank" class="keywords">代码转换</a>为十进制<a href="https://www.jb51.cc/tag/daima/" target="_blank" class="keywords">代码</a> Public Function c2to10(ByVal x As String) As String c2to10 = 0 If x = "0" Then Exit Function Dim i As Long i = 0 For i = 0 To Len(x) - 1 If Mid(x,Len(x) - i,1) = "1" Then c2to10 = c2to10 + 2 ^ (i) Next End Function
