スクリーンショットを撮っているとフォルダにファイルが貯まりすぎて整理が難しくなってしまいます。
今年だけで既に1万を超えていました…（笑）
そこで整理をする為にいくつかスクリプトを作ってみました。スクリプトはVBSで作っています。スクリプトをコピペしてもらえれば使えると思います。
写真が好きで貯まりってしまったファイルの整理にも良いかもしれません。
VBScriptのについて
使い方
- VBScriptは下記の物をメモ帳等に貼り付けて、ファイル名を「～.vbs」にしてもらえれば使えます。ただし、メモ帳の場合、標準の「文字コード」が "UTF-8" になっていると思いますので、ファイル保存時に "ANSI" に変更してくださいね。
- 作成した VBScript にファイルをドラッグ＆ドロップすればそれぞれのスクリプトが動きます。
- 「右クリック」-「送る」で利用できるようにもできます。
「ファイル名を指定して実行」で 「shell:sendto」と入力し [OK] を選んで表示されたフォルダーに作成した VBScript をコピーしてください。
- イメージ
[test1.jpg][test1.jpg]を選択し、「選択したファイルを更新月毎のフォルダへ移動」
↓ 201908のフォルダーへ移動されました。
注意事項
- スクリプトを利用して、問題等発生しても責任は取れないのでご了承ください。
選択したファイルを[年月日時分秒]のフォルダへ移動(VBS)
概略
- 選択したファイル(複数可)を VBS にドロップすると、[年月日時分秒]のフォルダーに移動されます。
- [年月日時分秒]のフォルダーは、ファイルがあるフォルダーに作成されます。
- ファイルの移動に失敗した場合は、失敗したファイルがリスト表示されます。
- 移動先に同一のファイルが存在すると、移動は行われず、失敗として扱われます。
- (注意)選択したファイル数が多すぎると、エラーになります。選択するファイル数を減らしてください(500個ぐらい迄?)
スクリプト
Option Explicit
On Error Resume Next
Dim strErrorMsg ' エラーメッセージ
Dim objFSO ' FileSystemObject
Dim strSrcFolder ' ソースフォルダー名
Dim strDstFolder ' 移動先フォルダー名
Dim i ' カウンター
strErrorMsg = ""
' 移動先フォルダー名(yyyyMMddHHmmss)
strDstFolder = Replace(Replace(Replace(Now(),"/",""),":","")," ","") &"\"
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
If Err.Number = 0 Then
For i = 0 To Wscript.Arguments.Count -1
' 移動先フォルダを作成する
strSrcFolder = objFSO.GetParentFolderName(WScript.Arguments(i)) & "\" & strDstFolder
If objFSO.FolderExists(strSrcFolder) = False Then
objFSO.CreateFolder(strSrcFolder)
End If
' ファイルの移動する
objFSO.MoveFile WScript.Arguments(i), strSrcFolder
' ファイルの移動に失敗したファイルの記録する
If Err.Number <> 0 Then
If strErrorMsg <> "" Then
strErrorMsg = strErrorMsg & vbCrLf
End If
strErrorMsg = strErrorMsg & WScript.Arguments(i)
End If
Next
Else
' ファイル操作に失敗した場合の記録する
strErrorMsg = "ファイル操作に失敗しました。"
End If
' エラーがあった場合、メッセージを表示する
If strErrorMsg <> "" Then
MsgBox "以下のファイルの移動に失敗しました。" & vbCrLf & strErrorMsg _
, vbExclamation, "エラー"
End If
Set objFSO = Nothing
選択したファイルを更新月毎のフォルダへ移動(VBS)
概略
- 選択したファイル(複数可)を VBS にドロップすると、[年月]のフォルダーに移動されます。
- [年月]のフォルダーは、ファイルがあるフォルダーに作成されます。
- ファイルの移動に失敗した場合は、失敗したファイルがリスト表示されます。
- 移動先に同一のファイルが存在すると、移動は行われず、失敗として扱われます。
- (注意)選択したファイル数が多すぎると、エラーになります。選択するファイル数を減らしてください(500個ぐらい迄?)
スクリプト
Option Explicit
On Error Resume Next
Dim strErrorMsg ' エラーメッセージ
Dim objFSO ' FileSystemObject
Dim strSrcFolder ' ソースフォルダー名
Dim strDstFolder ' 移動先フォルダー名
Dim i ' カウンター
strErrorMsg = ""
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
If Err.Number = 0 Then
For i = 0 To Wscript.Arguments.Count -1
' 移動先フォルダー名(yyyyMM)
strDstFolder = Replace(Left(objFSO.GetFile(WScript.Arguments(i)).DateLastModified,7),"/","") & "\"
' 移動先フォルダを作成する
strSrcFolder = objFSO.GetParentFolderName(WScript.Arguments(i)) & "\" & strDstFolder
If objFSO.FolderExists(strSrcFolder) = False Then
objFSO.CreateFolder(strSrcFolder)
End If
' ファイルの移動する
objFSO.MoveFile WScript.Arguments(i), strSrcFolder
' ファイルの移動に失敗したファイルの記録する
If Err.Number <> 0 Then
If strErrorMsg <> "" Then
strErrorMsg = strErrorMsg & vbCrLf
End If
strErrorMsg = strErrorMsg & WScript.Arguments(i)
End If
Next
Else
' ファイル操作に失敗した場合の記録する
strErrorMsg = "ファイル操作に失敗しました。"
End If
' エラーがあった場合、メッセージを表示する
If strErrorMsg <> "" Then
MsgBox "以下のファイルの移動に失敗しました。" & vbCrLf & strErrorMsg _
, vbExclamation, "エラー"
End If
Set objFSO = Nothing
選択したファイルを更新日毎のフォルダへ移動(VBS)
概略
- 選択したファイル(複数可)を VBS にドロップすると、[年月日]のフォルダーに移動されます。
- [年月日]のフォルダーは、ファイルがあるフォルダーに作成されます。
- ファイルの移動に失敗した場合は、失敗したファイルがリスト表示されます。
- 移動先に同一のファイルが存在すると、移動は行われず、失敗として扱われます。
- (注意)選択したファイル数が多すぎると、エラーになります。選択するファイル数を減らしてください(500個ぐらい迄?)
スクリプト
Option Explicit
On Error Resume Next
Dim strErrorMsg ' エラーメッセージ
Dim objFSO ' FileSystemObject
Dim strSrcFolder ' ソースフォルダー名
Dim strDstFolder ' 移動先フォルダー名
Dim i ' カウンター
strErrorMsg = ""
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
If Err.Number = 0 Then
For i = 0 To Wscript.Arguments.Count -1
' 移動先フォルダー名(yyyyMMdd)
strDstFolder = Replace(Left(objFSO.GetFile(WScript.Arguments(i)).DateLastModified,10),"/","") & "\"
' 移動先フォルダを作成する
strSrcFolder = objFSO.GetParentFolderName(WScript.Arguments(i)) & "\" & strDstFolder
If objFSO.FolderExists(strSrcFolder) = False Then
objFSO.CreateFolder(strSrcFolder)
End If
' ファイルの移動する
objFSO.MoveFile WScript.Arguments(i), strSrcFolder
' ファイルの移動に失敗したファイルの記録する
If Err.Number <> 0 Then
If strErrorMsg <> "" Then
strErrorMsg = strErrorMsg & vbCrLf
End If
strErrorMsg = strErrorMsg & WScript.Arguments(i)
End If
Next
Else
' ファイル操作に失敗した場合の記録する
strErrorMsg = "ファイル操作に失敗しました。"
End If
' エラーがあった場合、メッセージを表示する
If strErrorMsg <> "" Then
MsgBox "以下のファイルの移動に失敗しました。" & vbCrLf & strErrorMsg _
, vbExclamation, "エラー"
End If
Set objFSO = Nothing
選択したフォルダ内のファイルを更新月毎のフォルダへ移動(VBS)
概略
- ファイル数が多すぎる場合の改善版です。ファイルではなくフォルダー(単一)を指定してください。
- 選択したフォルダ(複数不可)を VBS にドロップすると、[年月]のフォルダーに移動されます。
- [年月]のフォルダーは、ファイルがあるフォルダーに作成されます。
- ファイルの移動に失敗した場合は、失敗したファイルがリスト表示されます。
- 移動先に同一のファイルが存在すると、移動は行われず、失敗として扱われます。
スクリプト
Option Explicit
On Error Resume Next
Dim strErrorMsg ' エラーメッセージ
Dim objFSO ' FileSystemObject
Dim strFileList ' ファイル一覧
Dim strSrcFolder ' ソースフォルダー名
Dim strDstFolder ' 移動先フォルダー名
Dim i ' カウンター
strErrorMsg = ""
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
set strFileList = objFSO.GetFolder(WScript.Arguments(0)).Files
If Err.Number = 0 Then
For Each i in strFileList
' 移動先フォルダー名(yyyyMM)
strDstFolder = Replace(Left(objFSO.GetFile(WScript.Arguments(0) & "\" & i.Name).DateLastModified,7),"/","") & "\"
' 移動先フォルダを作成する
strSrcFolder = WScript.Arguments(0) & "\" & strDstFolder
If objFSO.FolderExists(strSrcFolder) = False Then
objFSO.CreateFolder(strSrcFolder)
End If
' ファイルの移動する
objFSO.MoveFile WScript.Arguments(0) & "\" & i.Name, strSrcFolder
' ファイルの移動に失敗したファイルの記録する
If Err.Number <> 0 Then
If strErrorMsg <> "" Then
strErrorMsg = strErrorMsg & vbCrLf
End If
strErrorMsg = strErrorMsg & WScript.Arguments(i)
End If
Next
Else
' ファイル操作に失敗した場合の記録する
strErrorMsg = "ファイル操作に失敗しました。"
End If
' エラーがあった場合、メッセージを表示する
If strErrorMsg <> "" Then
MsgBox "以下のファイルの移動に失敗しました。" & vbCrLf & strErrorMsg _
, vbExclamation, "エラー"
End If
Set objFSO = Nothing
0 件のコメント:
コメントを投稿