写真の整理は削除・削除・が基本。しかし、ファイル名変換スクリプト（VBS）で簡単整理（２）

管理者用

先日、画像ファイルの整理のためのVBスクリプトを紹介しました。
写真を保存しているフォルダー名と、写真のExif情報から、写真のファイル名にフォルダー名と撮影日を追加したものに変換すると言うものでした。

先日紹介したスクリプトは、そのvbsファイルの保存しているフォルダー全てのＪＰＧファイルを対象に変換します。

これは、これで良いのですが、スクリプトファイルをコピー又は移動する必要があります。また、指定した画像ファイルだけを対象に変換したいなどの事もありました。

今回は、少し改造して、ｖｂｓファイルにドラッグしたファイル、または、フォルダーを対象に変換するスクリプトに変えました。
これも使えると思います。

実は、昨日、私にヒントをくれた、鳥撮り仲間の一人に、前回のものと合わせ、今回のスクリプトをファイルで渡しました。
使ってみるとの事、どのような意見が帰ってくるのか楽しみです。

＜使い方＞

下記のスクリプトをメモ帳等にコピーして拡張子を　．ｖｂｓ　のファイル名で保存してください。

どこでも良いのですが、ディスクトップ上が使いやすいかもしれません。

ディスクトップ上の、VBSスクリプトのアイコンに、変換したい画像ファイル（複数が可能）をドラッグする。
ドラッグした、写真ファイルのファイル名が変換されている。
フォルダーをドラッグすると、そのフォルダー内のＪＰＧ画像ファイル全てが変換されます。

※スクリプトの使用にあたっての不具合等に対し、弊社の責任は有りません事をご了解の上、自己責任の元行ってください。
スクリプトと言っても、ファイルを操作するプログラムです、十分注意して行ってくださいね。


Option Explicit
'============================
Dim i   
Dim objArgs
Dim objFSO
Dim objFiles
Dim objParentFolder
Dim objWshShell
Dim strParentFolder
Dim objIMGH_File

Set objArgs = WScript.Arguments
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objWSHShell = CreateObject("Shell.Application")
For i = 0 To objArgs.Count - 1
    If objFSO.FileExists(objArgs(i)) Then
        Set objFiles = objFSO.GetFile(objArgs(i))
        Call renameFile(objFiles)   
    ElseIf objFSO.FolderExists(objArgs(i)) Then
        Set objParentFolder = objFSO.GetFolder(objArgs(i))
        Call renameFolder(objParentFolder)
    End If
Next
Set objParentFolder = Nothing   
Set objFiles = Nothing   
Set objArgs = Nothing   
Set objFSO = Nothing   
WScript.Quit   
'=============================================================
Sub renameFile(objFiles)   
	On Error Resume Next   
	Dim strExName    
	Dim newfn
	Dim imgIdx
	Dim FolderNAME
	Dim imgFilena
	Dim FolderRetu
	Dim satueiDate
	Dim satueiDate_A
        Dim folder_kaiso
        Dim JPGIndx
	Dim objWSHFolder
	Dim fileMotonaji
	Dim strText

	strExName = objFSO.GetExtensionname( objFiles)   
	'msgbox strExName
	if strExName = "JPG" or strExName = "jpg" Then
		newfn =  objFiles.DateCreated   
		folder_kaiso = left(objFiles.path , len(objFiles.path) - len(objFiles.name) - 1) 
		FolderNAME = Split(folder_kaiso,"\")	'\フォルダー階層区切りの￥マークでSPLIT
		FolderRetu = UBound(FolderNAME) 'フォルダー階層数
		imgFilena  = FolderNAME(FolderRetu)'画像ファイルのフォルダー名を取得
		'既にフォルダー名が付いているファイルは名前の変更は行わない
		fileMotonaji = InStr(1,objFiles.Name, imgFilena, 1)
		If fileMotonaji = 0 Then
			Set objWSHFolder = objWshShell.Namespace(folder_kaiso) 
			strText="" 
			'画像データから撮影日を取得
			JPGIndx = 12
			strText = objWSHFolder.GetDetailsOf(objWSHFolder.ParseName( objFiles.name), JPGIndx)
			if steText = "" then
				'撮影日情報が無い場合は更新日情報を取得
				JPGIndx = 3
				strText = objWSHFolder.GetDetailsOf(objWSHFolder.ParseName( objFiles.name), JPGIndx)
			end if
			'日付データの正規化
			satueiDate = InStr(1,strText, " ", 1)
			satueiDate_A = Mid(strText, 1, satueiDate - 1)
			satueiDate_A = Replace(satueiDate_A, "/", "-")   
			'ファイル名を書き換える　フォルダ　－　日付　－　元のファイル名
			objFiles.Name =  imgFilena & "-" & satueiDate_A & "-" & objFiles.Name
		End If
	End If
End Sub   
'==================================
Sub renameFolder(objParentFolder)   
    Dim FoldFile
    Dim objFiles
    Dim FoldInfc
    Dim SFile  
    Set FoldFile = objParentFolder.Files   
    For Each objFiles In FoldFile   
        Call renameFile(objFiles )   
    Next
       Set  FoldInfc = objParentFolder.SubFolders   
    For Each SFile In  FoldInfc   
        Call renameFolder(SFile) 
      Next   
    Set FoldFile = Nothing   
    Set SFile = Nothing   
End Sub
'=======================================