'_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/
                                     
'                  画像ファイル大きさ振り分けスクリプト
                                     
'_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/

'【本スクリプトの概要】
'画像の横幅、高さを基にして画像ファイルを二つのフォルダに振り分ける
'スクリプトです。

'【使用方法】
'�@本ファイルの拡張子を「vbs」に変更し、デスクトップなど好きな
'  ディレクトリに置く。
'�A振り分けたい画像ファイルが入っているフォルダを本ファイルに
'  ドラッグ＆ドロップする。
'  尚、複数フォルダは処理できません。またサブフォルダも処理できません。
'�B出現するダイアログに振り分けの基準とする横幅、高さをピクセル単位で
'  入力する。
'  この横幅以上かつ高さ以上の画像ファイルを、ドラッグ＆ドロップした
'  フォルダ内に作成する「larger」フォルダに移動します。

'【使用上の注意点】
'●PNG画像には対応していません。対応しているファイル形式は、
'  ビットマップ (.bmp)、アイコン (.ico)、RLE (.rle)、メタファイル (.wmf)、
'  EMF (.emf)、GIF (.gif)、JPEG (.jpg) です。

'【使用例】
'●1024×768ピクセル内に収まる画像とそれ以外の画像に分けたい
'  �@横幅に「1025」、高さに「0」を指定して振り分ける。
'  �A横幅に「0」、高さに「769」を指定して振り分ける。
'  �Bドラッグ＆ドロップしたフォルダ直下に1024×768ピクセル内に収まる画像が
'    「larger」フォルダにそれ以外の画像が振り分けられる。

Option Explicit

Dim objShell
Dim objFolder
Dim objFolderItems
Dim objItem

Set objShell = CreateObject("shell.application")

On Error Resume Next
Set objFolder = objShell.NameSpace(WScript.Arguments.Item(0))
If Err.Number Then
	MsgBox "フォルダをドラッグ＆ドロップして下さい", vbOKOnly, "エラー"
	WScript.Quit
End If
On Error GoTo 0

If (objFolder Is Nothing) Then
	MsgBox "フォルダをドラッグ＆ドロップして下さい", vbOKOnly, "エラー"
	WScript.Quit
End If

Dim objFileSys
Dim strCreateFolder

Set objFileSys = CreateObject("Scripting.FileSystemObject")
strCreateFolder = objFileSys.BuildPath(WScript.Arguments.Item(0), "larger")

If objFileSys.FolderExists(strCreateFolder) Then
	If MsgBox("すでに「larger」フォルダがありますが続行しますか？", vbYesNo + vbQuestion, "確認") = vbNo Then
		WScript.Quit
	End If
End If

On Error Resume Next
objFileSys.CreateFolder strCreateFolder	'ドラッグ＆ドロップしたフォルダ内に「larger」フォルダを作成
Err.Clear
On Error GoTo 0

strCreateFolder = strCreateFolder & "\"

Dim w
Dim h

w = InputBox("振り分けの基準となる横幅（単位はピクセル）を入力して下さい。この値に満たない画像は移動しません", "divide_img_size")
If (w = "") Then
	MsgBox "処理を中止しました", vbOKOnly, "確認"
	WScript.Quit
ElseIf (Not IsNumeric(w)) Then
	MsgBox "数値を入力して下さい", vbOKOnly, "エラー"
	WScript.Quit
End If

h = InputBox("振り分けの基準となる高さ（単位はピクセル）を入力して下さい。この値に満たない画像は移動しません", "divide_img_size")
If (h = "") Then
	MsgBox "処理を中止しました", vbOKOnly, "確認"
	WScript.Quit
ElseIf (Not IsNumeric(h)) Then
	MsgBox "数値を入力して下さい", vbOKOnly, "エラー"
	WScript.Quit
End If

w = CInt(w)
h = CInt(h)

Dim oLocator
Dim oService
Dim oClassSet
Dim oClass
Dim dpi

Set oLocator = Wscript.CreateObject("WbemScripting.SWbemLocator")
Set oService = oLocator.ConnectServer
Set oClassSet = oService.InstancesOf("Win32_DisplayConfiguration")

For Each oClass In oClassSet
	dpi = oClass.LogPixels
Next
		
Dim pic
Dim x
Dim y

Set objFolderItems = objFolder.Items()

For Each objItem In objFolderItems
	If (Not objItem.IsFolder) Then	'アイテムオブジェクトがファイルだった場合
		On Error Resume Next
		Set pic = LoadPicture(objItem.Path)
		If (Err.Number = 0) Then	'ファイルが読み込める画像ファイルだった場合
			x = CLng(CDbl(pic.Width) * dpi / 2540)
			y = CLng(CDbl(pic.Height) * dpi / 2540)
			If (x >= w And y >= h) Then	'画像の大きさが指定した値以上で、移動すべきファイルだった場合
				objFileSys.MoveFile objItem.Path, strCreateFolder	'「larger」フォルダに移動
			End If
		End If
		Err.Clear
		On Error GoTo 0
	End If
Next

MsgBox "処理完了", vbOKOnly, "確認"