スクリーンショット(SS)等のファイル整理のスクリプト|うぃむんののんびりギャザクラ日誌 #FF14

ページ

▼

スクリーンショット(SS)等のファイル整理のスクリプト

こんにちは、うぃむです。

スクリーンショットを撮っているとフォルダにファイルが貯まりすぎて整理が難しくなってしまいます。

今年だけで既に1万を超えていました…（笑）

そこで整理をする為にいくつかスクリプトを作ってみました。スクリプトはVBSで作っています。スクリプトをコピペしてもらえれば使えると思います。
写真が好きで貯まりってしまったファイルの整理にも良いかもしれません。

VBScriptのについて

使い方
  1. VBScriptは下記の物をメモ帳等に貼り付けて、ファイル名を「～.vbs」にしてもらえれば使えます。ただし、メモ帳の場合、標準の「文字コード」が "UTF-8" になっていると思いますので、ファイル保存時に "ANSI" に変更してくださいね。
  2. 作成した VBScript にファイルをドラッグ＆ドロップすればそれぞれのスクリプトが動きます。
  3. 「右クリック」-「送る」で利用できるようにもできます。
    「ファイル名を指定して実行」で 「shell:sendto」と入力し [OK] を選んで表示されたフォルダーに作成した VBScript をコピーしてください。
  4. イメージ
    [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
at
ランキングに参加しています。
ブログランキング・にほんブログ村へ

0 件のコメント:

コメントを投稿