お仕事 便利ツール

散らかったデスクトップを一撃で整理するVBSプログラム

会社のセキュリティの関係でアプリケーション自由に入れれないので
デスクトップを整理するスクリプトを作ったのでもしよかったら使ってください。

パソコンのデスクトップが散らかってると仕事できない奴って
決めつけられることありますよね。
忙しくて整理してる暇ないねんて!
デスクトップのファイル選択してフォルダ作ってほりこむだけやん
→それすらめんどい。

というわけで・・・このスクリプトを実行するだけで
散らかったデスクトップのファイルを年月のフォルダ作ってぶっこみます。

スクリプトはWindowsの標準的な命令しか使ってないので、
インストールもなくほとんどの環境で実行可能なはずです。

txt形式でスクリプト置きますので .vbsに拡張子変更して実行して下さい。
ご自由に(自己責任で)ご利用ください!

デスクトップ整理

ファイルダウンロード不安な方は下記スクリプトコードを
適当なファイル名.vbsとして保存して実行してもOKです。

あとがき(言い訳)

かなりの急造品なのと、整理ルールに合わせて調整?とかもあると思うので
なるべくシンプルな作りにしていますが、とりま使えればOKという次元なので
私の中でこれはもう完成した!超便利と自画自賛しています。
月変わりのテストしてないし、後々不都合あるかもしれんとか
もしかしたら実はコピー失敗してるとかあるかもしれないので、
本当に自己責任で、以下VBSソース
自分で作っときながら、、、
せめて公開するならプログラムコメントもうちょい書いとくべきやろって思う。

Dim fs
Dim fn
Dim outDir
Dim tgtDir
Dim ngFile
Dim log

'説明:デスクトップを整理するプログラム
'内容:デスクトップのファイル(フォルダ・ショートカット以外)を処理年月のフォルダに全部ぶっこむ
'エラー時:保管先に同名のファイルが既に存在する場合はエラー停止する(と思うw)

Dim WS
Set WS = CreateObject("WScript.Shell")

outDir = WS.SpecialFolders("desktop") & "\" '整理対象フォルダ
tgtDir = outDir '出力先

msgbox outDir
'----------------------------
'メイン処理
'----------------------------
'対象フォルダの設定
setTarget

'対象フォルダを年月毎にフォルダ移動
createDir

'ファイル移動
moveFile

'処理結果
log = log & "ファイル整理完了"
WScript.Echo log

'----------------------------
'対象ディレクトリのファイルを出力先フォルダに一括で移動
Sub moveFile
	On Error Resume Next
	Dim objFileSys
	Dim objFolder
	Dim objFile
	Dim fList

	'ファイルシステムを扱うオブジェクト
	Set objFileSys = CreateObject("Scripting.FileSystemObject")
	Set objFolder = objFileSys.GetFolder(outDir)
	Set fs = WScript.CreateObject("Scripting.FileSystemObject")

	For Each objFile In objFolder.Files
		'取得したファイル名を表示
		fList = fList & objFile.Name & vbCrlf

		' 対象ファイルにこのスクリプトが含まれている場合除外
		If objFile.Name <> WScript.ScriptName Then
			'ファイル移動
			log = log & "move " & outDir & objFile.Name & "→" & tgtDir & objFile.Name & vbCrlf
			fs.MoveFile outDIr & objFile.Name , tgtDir & objFile.Name
		End If
	Next
End Sub

'----------------------------
Sub setTarget
	If strFormattedDate = "" Then
		'yyyy/mm/dd hh:mm:ss 形式で現在日付を取得
		strFormattedDate = Now()
	End If

	'yyyy/mm.dd hh:mm:ss から yyyy/mmのみ抽出
	strFormattedDate = Left(strFormattedDate, 7)

	'/を削除してyyyymmに編集
	strFormattedDate = Replace(strFormattedDate, "/", "")

	'yyyymmdd 形式の文字列をダイアログに表示
	tgtDir = tgtDir & strFormattedDate & "\"
End Sub

'----------------------------
Sub createDir
	On Error Resume Next
	Dim str_path
	Set objFs = CreateObject("Scripting.FileSystemObject")

	'フォルダを作成する
	str_path = objFS.CreateFolder(tgtDir)
End Sub
 

返信する

メールアドレスが公開されることはありません。 が付いている欄は必須項目です