あれあの備忘録

アプリ作成の備忘録、IT関連のニュースなどなどいろいろ

vbsで特定のディレクトリの一階層にある同じ名前のフォルダを指定のパスにコピーする

こんにちは!
ra-men-tarouです。

仕事でフォルダのコピーを自動化する必要がありましたので

そのときの備忘録です。

なんで今時vbsかというとwindowsだから。。。

自分だけ使う環境なら他にも言語の選択肢はあると思いますが、

他者が使うときの学習コストや言語のインストール作業、

環境の管理を考えるとvbsやdosコマンドが第一の選択肢として上がる

場面も少なくないと思います。 そこで今回はvbsを選択しました。

例えばCドライブ直下に下のようなディレクトリ構造があったとします。

C:.
+---chiba
|   +---ra-men
|   |       担々麺.txt
|   |
|   \---sushi
|           まぐろ.txt
|
+---kanagawa
|   +---ra-men
|   |       しょうゆとんこつ.txt
|   |
|   \---sushi
|           しらす.txt
|
\---tokyo
    +---ra-men
    |       しょうゆ.txt
    |
    \---sushi
            あなご.txt

ディレクトリ構造が「店名\メニューカテゴリ\その日のおすすめメニュー」だったとします。
この中から神奈川店と東京店のすしのおすすめメニューをC:\menu直下に保存したいとします。

ソース

ソースは下記の通りです

Option Explicit

Dim objFileSys
Dim strScriptPath
Dim objFolder
Dim objItem
Dim checkArray

Set objFileSys = CreateObject("Scripting.FileSystemObject")

strScriptPath = Replace(WScript.ScriptFullName,WScript.ScriptName,"")

Set objFolder = objFileSys.GetFolder(strScriptPath)

checkArray = Array("tokyo","kanagawa")

For Each objItem In objFolder.SubFolders
    If (CheckInStr(objItem.Name,checkArray)) Then
      call CopyDir(objItem.Name)
    End If
Next

Set objFolder = Nothing
Set objFileSys = Nothing

'*****************************************************************************
'* 関数名  | CheckInStr
'* 概要    | 指定された文字列の中に文字列配列に格納された文字列がないか確認する
'* 戻り値   | True:含まれる False:含まれない
'*****************************************************************************
Function CheckInStr(dirname,checkList)
    Dim checkItem

    CheckInstr = False

    For Each checkItem In checkList
      If InStr(dirname,checkItem) Then
        CheckInStr = True
      End If
    Next
End Function

'*****************************************************************************
'* 関数名  | CopyDir
'* 概要    | dosコマンドで指定されたフォルダをフォルダごと指定のパスに上書きコピーする
'* 戻り値   | なし
'*****************************************************************************
Sub CopyDir(dirName)
    Dim strCmd,fromDir,toDir,RC
    Dim objWshShell

    strCmd  = "cmd /c echo D | xcopy "
    fromDir = "c:\"& dirName & "\" & "sushi"
    toDir   = "c:\menu\"& "sushi"

    Set objWshShell = WScript.CreateObject("WScript.Shell")
    RC = objWshShell.Run(strCmd & fromDir &" "& toDir & " /s/e/y", 0, True)

    Set objWshShell = Nothing
End Sub

公開されているライブラリで似たようなことができるものがあればなー、と思います。 なかなか探すにはコツがいるのですが。。。

それでは!