特定の名前が含まれるファイルを取り出す

大量の効果音ファイルの中で、voiceという名前が含まれるファイル名など
特定の名前を含むファイルのみを抜き出したかったのでそのVBSを作ってみました。

VBSファイルがある階層のみからしか検索しないので注意が必要です。

この配列の中の文字列を書き換えることにより対象を指定できます。

strSearch = Array("voice", "footstep", "wind", "whoosh", "weapon")
'***********************************************
'ファイル名に特定の文字列を含むもののみを抜き出す
'***********************************************
Option Explicit

Dim strSearch
strSearch = Array("voice", "footstep", "wind", "whoosh", "weapon")



Dim objFso
set objFso = createObject("Scripting.FileSystemObject")

'配列の最大INDEX
Dim len
len = UBound(strSearch)

'現在のパスを取得
Dim strCurFolderPath
strCurFolderPath = objFso.getParentFolderName(Wscript.ScriptFullName)

'格納先フォルダの作成
Dim i
Dim strTargetPath
for i = 0 to len step 1

    strTargetPath = strCurFolderPath & "/" & strSearch(i)
    if not objFso.FolderExists(strTargetPath) Then

        objFso.CreateFolder(strTargetPath)

    end if
next

'現在のパスのファイル一覧を検索
Dim folder
Dim file
Dim retInStr
Dim strCopyFrom
Dim strCopyTo

'フォルダを取得
set folder = objFso.getFolder(strCurFolderPath)

for each file in folder.files
    for i = 0 to len step 1

        retInStr = InStr(1, file.name, strSearch(i), 1)
        
        '文字が含まれている場合
        if retInStr<>0 or retInStr<>NULL Then

            '格納先フォルダへファイルをコピー
            strCopyFrom = strCurFolderPath & "/" & file.name
            strCopyTo = strCurFolderPath & "/" & strSearch(i) & "/"

            Call objFso.CopyFile(strCopyFrom, strCopyTo, True)

        '文字が含まれていない場合
        else
            
        end if
    next
next

コメント

タイトルとURLをコピーしました