Trich xuất cấu trúc thư mục nhiều cấp

Tình huống thường ngày: Bạn sưu tầm được hàng trăm bài hát được phân loại theo từng tác giả. Mỗi tác giả là một thư mục. Trong mỗi thư mục tác giả lại có nhiều thư mục con là tên của từng album. Ví dụ: D:\music\Nhac-Viet\Ho-Ngoc-Ha\Khuc-Mua\Dem-Nghe-Tieng_mua.mp3. Câu hỏi đặt ra ở tình huống này là làm sao để lấy hết một lần cấu trúc thư mục cho từng bài hát của 100 ca sĩ với hơn 500 albums?

 

Điều kiện: Windows XP, Vista, một cơ sở dữ liệu nhạc được lưu theo cấu trúc D:\music\nhac-viet\ca-si\album\ten-bai-hat.mp3

 

Giải pháp: Giải pháp của HelloICT là dùng mã VB Script để trích xuất cấu trúc thư mục này.

 

Bước 1: Bạn có thể tải chương trình trích xuất nhỏ này do BiBo chế biến.

Bước 2: Copy tập tin này vào thư mục chứa tập tin bài hát.

Bước 3: Nhấp kép vào tập tin Xuat tap tin trong Folder va SubF.vbs để thực thi. Kết quả là một tập tin mới có tên KetQua.txt được tạo ra trong cùng thư mục. Script này cũng tự động mở tập tin KetQua.txt để bạn thấy ngay cấu trúc thư mục mà mình cần.

{tipbox_right}

Đoạn mã đã sử dụng (tham khảo):

' Developed by BiBo. http://www.helloict.com
' Code dung de trich xuat cau truc thu muc nheu cap
'=========================================

' lay path hien hanh
DIM path
path = WScript.ScriptFullName  ' script file name
GetPath = Left(path, InstrRev(path, "\"))

Dim oFilesys, oFiletxt, sFilename, sPath

Set oFilesys = CreateObject("Scripting.FileSystemObject")

Set oFiletxt = oFilesys.CreateTextFile(GetPath & "KetQua.txt", True)

sPath = oFilesys.GetAbsolutePathName(GetPath & "KetQua.txt")

sFilename = oFilesys.GetFileName(sPath)

'List tat ca cac file

Set objFSO = CreateObject("Scripting.FileSystemObject")
objStartFolder = GetPath
Set objFolder = objFSO.GetFolder(objStartFolder)
'Wscript.Echo objFolder.Path
Set colFiles = objFolder.Files
For Each objFile in colFiles
'Ghi file cua Folder
oFiletxt.WriteLine(objFolder.Path & "\" & objFile.Name)
Next

ShowSubfolders objFSO.GetFolder(objStartFolder)
Sub ShowSubFolders(Folder)
    For Each Subfolder in Folder.SubFolders
        Set objFolder = objFSO.GetFolder(Subfolder.Path)
        Set colFiles = objFolder.Files

        For Each objFile in colFiles
            oFiletxt.WriteLine(objFolder.Path & "\" & objFile.Name)
        Next

      ShowSubFolders Subfolder
    Next
End Sub

oFiletxt.Close

Sub Run(ByVal sFile)
Dim shell

    Set shell = CreateObject("WScript.Shell")
    shell.Run Chr(34) & sFile & Chr(34), 1, false
    Set shell = Nothing
End Sub

If oFilesys.FileExists(sPath) Then Wscript.Echo "Cau truc thu muc duoc luu trong tap tin ",sFilename&"."
run sFilename

Chúc các bạn thành công!

{emailalert}