ray88’s diary

お仕事で困ったとき用の自分用の覚書

VBS フォルダの移動

■書式

Dim FSO
Set FSO = WScript.CreateObject("Scripting.FileSystemObject")
FSO.MoveFolder 対象フォルダパス,移動後のフォルダパス

■例:「雛形ファイル格納用」フォルダと直近3日分のフォルダを残し残りを移動する
f:id:ray88:20210430234932p:plain
f:id:ray88:20210430233658p:plain
■サンプルコード

'----------------------------------------------------------
'対象フォルダ内のサブフォルダを移動先フォルダに移動させる
'但し「雛形ファイル格納用」フォルダと直近日付3日分のフォルダは
'移動させずに残す。
'----------------------------------------------------------
Dim FSO			'FileSystemオブジェクト格納用
Dim strFolderPath	'フォルダパス格納用
Dim Folder		'対象フォルダ内のサブフォルダを一括格納		
Dim subFolderName	'サブフォルダ名格納用
Dim intStopNum		'繰り返し処理ストップ用インデックスを格納
Dim intCount		'繰り返し処理カウント用
Dim strTargetPath	'処理対象サブフォルダのフルパス
Dim strIdouFolderPath	'サブフォルダの移動先フォルダパス

Set FSO = WScript.CreateObject("Scripting.FileSystemObject")
'対象フォルダパス(移動元)と移動先フォルダパスを設定
strFolderPath = "C:\Users\yamada\OneDrive\デスクトップ\BackUp\テスト"
strIdouFolderPath = "C:\Users\yamada\OneDrive\デスクトップ\BackUp\移動先"

'FileSystemオブジェクトをインスタンス化
set Folder = FSO.GetFolder(strFolderPath)
'対象フォルダ内のサブフォルダ数をカウント
intFolderCount = Folder.subFolders.Count
'「雛形ファイル格納用」フォルダと直近日付3フォルダを残すためフォルダ総数から
'マイナス4のインデックス数で繰り返しをストップさせるストップ用インデックスを設定
intStopNum = intFolderCount - 4
'繰り返し処理用カウンタ初期化
intCount = 1

'対象フォルダのサブフォルダ数で繰り返し処理
For Each subFolder In Folder.subFolders
	'サブフォルダ名取得
	subFolderName = subFolder.Name
	'カウンタがストップの数に達してないか確認
	if intCount > intStopNum Then
		Exit For
	End If
	'フォルダ名が「雛形ファイル格納用」ではないか?
	If subFolderName <> "雛形ファイル格納用" Then
		'移動元サブフォルダのフルパスを取得
		strTargetPath = strFolderPath & "\" & subFolderName
		'サブフォルダ移動処理
		FSO.MoveFolder strTargetPath,strIdouFolderPath & "\" & subFolderName
		'カウンタ変数に1足す
		intCount = intCount + 1
	End If
Next

■例2:フォルダ内の「20」から始まるフォルダ名のサブフォルダを全て移動させる
f:id:ray88:20210430234932p:plain
f:id:ray88:20210430235006p:plain
■サンプルコード
※移動元フォルダ名が「*」を使用したあいまい指定の場合、移動先のパスはフォルダパスのみでOK
移動元フォルダが「*」を使用せず固定パスの場合は移動先のパスもフルパスで指定する。

'----------------------------------------------------------
'対象フォルダ内のサブフォルダのうち「20」から始まるフォルダ名
'を移動先フォルダに全て移動させる
'----------------------------------------------------------
Dim FSO			'FileSystemオブジェクト格納用
Dim strFolderPath	'フォルダパス格納用
Dim Folder		'対象フォルダ内のサブフォルダを一括格納		
Dim subFolderName	'サブフォルダ名格納用
Dim strIdouFolderPath	'サブフォルダの移動先フォルダパス

Set FSO = WScript.CreateObject("Scripting.FileSystemObject")

'対象フォルダパス(移動元)と移動先フォルダパスを設定
strFolderPath = "C:\Users\yamada\OneDrive\デスクトップ\BackUp\テスト"
strIdouFolderPath = "C:\Users\yamada\OneDrive\デスクトップ\BackUp\移動先"

'FileSystemオブジェクトをインスタンス化
set Folder = FSO.GetFolder(strFolderPath)

'フォルダ名が「20」から始まるサブフォルダのみを移動先フォルダへ移動させる
FSO.MoveFolder strFolderPath & "\20*",strIdouFolderPath