Top / Prog / VBScript / ファイル名を日付に変えて保存

概要

ウェブを巡回している時に、色々ファイルを引っ張ってくると思いますが、同名ファイルがあると、一々ファイル名を書き換える必要があり面倒です。

以下のスクリプトのショートカットをデスクトップ上に用意して、ダウンロードしたファイルをドラッグ&ドロップすると、ファイル名を日付に換えて、指定したフォルダに自動的に保存します。
直接起動すると、保存先フォルダを開きます。

コード

Option Explicit
On Error Resume Next
'---------------------------------------------------------------------
' ファイル名自動変更&任意フォルダ移動スクリプト
' by myasu
'
' Ver.1.00 2007/3/17
'---------------------------------------------------------------------

'----------------------------------
'変数の宣言
'----------------------------------
Dim iArguments									'引数カウンタ
Dim strArgument									'引数
Dim ary_strArguments							'引数配列
Dim strSaveFolder								'保存先フォルダ名
Dim objWShell									'
Set objWShell = CreateObject("WScript.Shell")
Dim objFSO										'ファイルシステムオブジェクト
Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objFile										'ファイルオブジェクト
Dim dtmNowDate									'時刻
Dim strDestFileName								'変更後ファイル名

'----------------------------------
'設定
'----------------------------------
strSaveFolder = "c:\"	'保存先フォルダ


'----------------------------------
'主処理
'----------------------------------

Set ary_strArguments = WScript.Arguments		'引数取得

iArguments = 1
If WScript.Arguments.Count = 0 Then
	'引数に指定がない場合、格納フォルダを開く
	'(http://www.happy2-island.com/vbs/cafe02/capter00110.shtml)
	objWShell.Run "rundll32.exe url.dll,FileProtocolHandler " & strSaveFolder
Else
	'引数にファイルが指定されていたら
	'(http://www.whitire.com/vbs/index.html)
	'(http://www1.u-netsurf.ne.jp/~tomo_c/tips/WSH003.html)
	For Each strArgument in ary_strArguments
		
		dtmNowDate = Now()								'現在時刻の取得
		strDestFileName = _
			strSaveFolder & "\" & _
			Year(dtmNowDate)& _
			Right("0" & Month(dtmNowDate), 2) & _
			Right("0" & Day(dtmNowDate), 2) & _
			Right("0" & Hour(dtmNowDate), 2) & _
			Right("0" & Minute(dtmNowDate), 2) & _
			Right("0" & Second(dtmNowDate), 2) & _
			Left("0" & iArguments, 3) & _
			"." & objFSO.GetExtensionName(strArgument)	'変更後ファイル名生成
			
			Set objFile = objFSO.GetFile(strArgument)	'元ファイルのオブジェクト生成
			
			objFSO.MoveFile strArgument, strDestFileName	'ファイルの移動
			If Err.Number = 0 Then
			Else
				WScript.Echo "ERROR: " & Err.Description & vbcrlf & vbcrlf & " From: " & strArgument & "" & vbcrlf & " To: " & strDestFileName
			End If
			
			iArguments = iArguments + 1
	Next
End If

参考

2007-05-13 (日) 11:11:04

Prog


トップ   編集 凍結解除 差分 バックアップ 添付 複製 名前変更 リロード   新規 一覧 単語検索 最終更新   ヘルプ   最終更新のRSS
Last-modified: 2007-05-13 (日) 11:14:49 (3696d)