2014年1月2日木曜日

「あの処理」までのVBScript (その4の2)no5 指定フォルダから再帰的にサブフォルダを検索する。

方針変更:
 よくよく考えたら(その4)で勢いファイル検索まで行ってしまったが、そんなとこまで行く必要なかったよな。
 なんで(その4)からファイル検索を省いて、「指定フォルダから再帰的にサブフォルダを検索する」バージョンを作ってみた。 こっちの方がアレとの親和性いいかもなー。



'以下、末尾までスクリプトです。
'
'実行例:Cscript FileSaikiSerch005.vbs ディレクトリ名 
Option Explicit

'処理概要
' 指定フォルダから再帰的にサブフォルダを検索する。
'
Dim oSFso , oAGS , oShellA

Dim sWRITE_LINE
Dim sPATH_ITEM0

'処理カウント
Dim iCONV_COUNTAll

'フォルダ・ファイル操作
Set oSFso = WScript.CreateObject("Scripting.FileSystemObject")

'ファイル属性確認
'再帰的に呼び出すので、宣言をメインループより出した
Set oShellA = WScript.CreateObject("Shell.Application")

'パラメータ確認用
Set oAGS = WScript.Arguments

If oAGS.count = 1 Then 
'置換用に元パス名保持
sPATH_ITEM0 = oAGS.item(0)

'処理カウント リセット
iCONV_COUNTAll  = 0

If oSFso.FolderExists( sPATH_ITEM0 ) = True  Then

'メインループ実行
   CALL GET_FOLDERMOVIE( sPATH_ITEM0 )

'処理終了 処理別カウント
WScript.Echo "####処理終了 処理別カウント####"
WScript.Echo vbTab & "ALL:" & iCONV_COUNTAll 
WScript.Echo "################################"
Else
   Wscript.Echo "引数が不正です。" & vbTab & oAGS.item(0)  

End if
Else
    Wscript.Echo "引数が不正です。" & vbTab & "実行例:Cscript FileSaikiSerch005.vbs ディレクトリ名 "

End If


'終了処理
Set oAgs = Nothing
Set oSFso = Nothing
Set oShellA = Nothing
Wscript.Quit 


Sub GET_FOLDERMOVIE(psPATH)
Dim cSFolder,oSFolder,oTemp,cFiler

Dim sMovie

Set cSFolder = oSFso.GetFolder(psPATH)
Set oSFolder = cSFolder.SubFolders

'エラーでも実行
on error resume next

For Each oTemp In oSFolder

sMovie = Left(oTemp.Name,1)
if sMovie ="$"  or sMovie ="." then

else
'初回はルートフォルダ
if iCONV_COUNTAll = 0 then
WScript.Echo psPATH
end if

'以後、サブフォルダフォルダ
WScript.Echo psPATH & "\" & oTemp.Name

'サブフォルダー検索
   GET_FOLDERMOVIE(psPATH & "\" & oTemp.Name)
end if 

Next

'サブフォルダー検索のみに使用
Set cFiler = cSFolder.Files
For Each oTemp In cFiler
sMovie = Left(oTemp.Name,1)
if sMovie ="$"  or sMovie ="." then

else
sMovie = Right(LCase(oTemp.Name) , 4)
If (sMovie = ".mp4" or sMovie = ".avi") Then
iCONV_COUNTAll = iCONV_COUNTAll + 1
End if
end if
Next

'エラークリア
err.clear
on error goto 0

'終了処理
Set cSFolder = Nothing
Set oSFolder = Nothing
Set oTemp = Nothing
Set cFiler = Nothing
End Sub

0 件のコメント:

コメントを投稿