MENU

• コンテンツ
  • プログラミング
  • エレクトロニクス
  • 家サーバ管理帳
  • Solaris Administrator
  • ごちゃ混ぜ実験
  • このサイトについて
    
• その他
  • サイトマップ
  • 人気ページ
  • 最新記事
    
• 掲示板・ゲストブック
  • FORUM
    
• リンク
  • ExattoSoftware
  • twitter
  • GitHub
    

Online: 1
Today: 1
Yesterday: 1
Total: 16677

概要 †

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

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

コード †

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

参考 †

Prog