画像仕訳支援・移動・削除シェル

画像ファイル仕訳支援（移動・削除）WSHとHTMLのGUI活用例

私はオークション用にデジカメなどで撮影した画像ファイルをフォルダ毎に仕訳している。
1.デジカメからpcへ移動
2.仕訳するフォルダを作成
3.画像ファイルを#2のフォルダに移動
#2と#3を繰り返すのだが、この繰り返し部分を簡略するシェルです
ブラウザにサムネイル見たいので一覧表示し、移動または削除対象の物にチェック
先頭のラジオボタンはこのシェルを置いたフォルダのサブフォルダの一覧です、このサブフォルダの下にフォルダを作る場合チェックしてください
削除：削除をチェックで削除動作
移動：移動先フォルダにフォルダ名入力・このシェルの置き場所が起点、移動をチェックでフォルダ作成+移動動作
移動した場合、最初の画像のパス名をクリップボードにコピーします。Yahooオークションのアップロード画像用に便利です

その他IE操作自動化、ブラウザにGUI見たいな操作を簡単にさせることができる例です
こちらは表示中のIEの画面を操作するためのVBのソースを生成の適用例です。若干WSH用に修正してます。指定内容を変えたいときは操作コードを出力して、下記のソースを修正してください
■Windows/XP,IE6で動作確認済み
以下、固定です。必要に応じソースを修正してください。
・.JPGのみ対象、大文字・小文字識別します。
・画像表示1行に8個
・画像を表示する大きさheight="100" width="80"
などなど
■使いかた
1.拡張子.vbsで適当なファイルを作成する
2.このvbsファイルをエディタで開く
3.下記ソーズをコピー、上記で開いた.vbsのファイルに貼り付ける
4.保存・終了する
5.このvbsファイルを実行（ダブルクリック）
6.IEが起動され、上記のような画面が表示される
7.上記で説明した、移動・削除の行為をしてください

■ソース

if WScript.Arguments.Count> 0 then
 for each itm in WScript.Arguments
  if i=0 then
   folderpath =itm & "\"
  end if
  i=i+1
 next
else
 folderpath = "./"
end if
set fs = CreateObject("Scripting.FileSystemObject")
Set objIEx = CreateObject("InternetExplorer.application")
objIEx.Navigate "about:blank"
Do While objIEx.Busy Or objIEx.ReadyState<>4
    Wscript.Sleep 10
Loop
'MsgBox objIEx.Document.parentWindow.clipboardData.getData("text")
objIEx.Visible = true
preRpos=-1
preFolder=""
Set logf = fs.OpenTextFile("ImgIchiranLog.txt",2,true)
logf.WriteLine "start " & Now
do
 InputTagNum=0
 Set oTs1 = fs.OpenTextFile("ImgIchiran.htm",2,true)
 r=0
 oTs1.WriteLine "<html>"
 oTs1.WriteLine "<head>"
 'oTs1.WriteLine "<script language=javascript>"
 'oTs1.WriteLine "function hchk(p)"
 'oTs1.WriteLine "alert(p);"
 'oTs1.WriteLine "end function"
 'oTs1.WriteLine "</script>"
 oTs1.WriteLine "</head><body>"
 set folder = fs.GetFolder(folderpath)
 for each a in folder.SubFolders
  oTs1.WriteLine "<input type=radio name=fSub value=""" & a.name & """"
  if InputTagNum=preRpos then oTs1.WriteLine " checked"
  oTs1.WriteLine ">" & a.name
  InputTagNum=InputTagNum+1
 next
 RadioEndNum=InputTagNum-1
 oTs1.WriteLine "<br>終了:<input type=checkbox name=endd>削除:<input type=checkbox name=del><br>"
 oTs1.WriteLine "移動先フォルダ:<input name=folderN size=40"
 if preFolder<>"" then oTs1.WriteLine " value=""" & preFolder & """"
 oTs1.WriteLine ">移動:<input type=checkbox name=move><br>"
 'oTs1.WriteLine "2箇所チェック範囲を一括する:<input type=checkbox name=ixtukatu value=checked><br>"
 InputTagNum=InputTagNum+4
 InputTagStart=InputTagNum
 oTs1.WriteLine "<table>"
 oTs1.WriteLine "<tr>"
  for each a in folder.Files
    if LCase(right(a.name,4))=".jpg" then
     'oTs1.WriteLine "<td><input type=checkbox onchange=""javascript:hchk(" & r & ")"" name=""" & a.name & """><a href=""./" & a.name & """>" & left(a.name,10) & "<br><img src=""" & a.name & """ height=""100"" width=""80""></a></td>"
    oTs1.WriteLine "<td><input type=checkbox name=""" & a.name & """><a href=""./" & a.name & """ TARGET=""_blank"">" & left(a.name,10) & "<br><img src=""" & a.name & """ height=""100"" width=""80""></a></td>"
    r=r+1
    InputTagNum=InputTagNum+1
     if r=8 then
      oTs1.WriteLine "</tr><tr>"
      r=0
     end if
    end if
  Next
 oTs1.WriteLine "</tr>"
 oTs1.WriteLine "</table>"
 oTs1.WriteLine "</body></html>"
 oTs1.close
 objIEx.Navigate "file://" & folder & "\ImgIchiran.htm"
 Do While objIEx.Busy
	WScript.Sleep 100
 Loop
 Do
  WScript.Sleep 100
  if objIEx.Document.all.move.checked=true then exit do
  if objIEx.Document.all.del.checked=true then exit do
  if objIEx.Document.all.endd.checked=true then exit do
 Loop
 if objIEx.Document.all.endd.checked=true then exit do
  if objIEx.Document.all.del.checked=true then
   for t_i=InputTagStart to InputTagNum-1
    if objIEx.document.all.tags("INPUT").item(t_i).checked=true then
     fn=objIEx.document.all.tags("INPUT").item(t_i).name
     fs.DeleteFile folder & "\" & fn
     logf.WriteLine "delete " & folder & "\" & fn
    end if
   Next
   objIEx.Document.all.del.checked=false
  end if
  if objIEx.Document.all.move.checked=true then
   if objIEx.Document.all.folderN.value="" then
    MsgBox "移動先フォルダを指定してください"
   else
   for t_i=0 to RadioEndNum
    folder_org=folder
    if objIEx.document.all.tags("INPUT").item(t_i).checked=true then
     folder=folder & "\" & objIEx.document.all.tags("INPUT").item(t_i).value
     preRpos=t_i
     exit for
    end if
    'if objIEx.Document.all.fSub.value<>"" then folder=folder & "\" & objIEx.Document.all.fSub.value
   next
   folderN = folder & "\" & objIEx.Document.all.folderN.value
   preFolder=objIEx.Document.all.folderN.value
   If (fs.FolderExists(folderN)) Then
    if MsgBox( folderN & "は、存在します。", VbOKCancel) = vbCancel Then WScript.Quit
    logf.WriteLine "folder already exist " & folderN
   Else
    'フォルダー作成
    Set f = fs.CreateFolder(folderN)
    logf.WriteLine "folder create " & folderN
   end if
   topF=true
   m_s=-1
   for t_i=InputTagStart to InputTagNum-1
    if objIEx.document.all.tags("INPUT").item(t_i).checked=true then
     m_s=t_i
     exit for
    end if
   Next
   if m_s<0 then
   else
    for t_i=InputTagNum-1 to InputTagStart step -1
     if objIEx.document.all.tags("INPUT").item(t_i).checked=true then
      m_e=t_i
      exit for
     end if
    Next
    for t_i=m_s to m_e
     fn=objIEx.document.all.tags("INPUT").item(t_i).name
'if MsgBox(folder & "\" & fn & " to " & folderN & "\" & fn, VbOKCancel) = vbOK  Then WScript.Quit
     fs.MoveFile folder_org & "\" & fn, folderN & "\" & fn
     logf.WriteLine "move " & folder_org & "\" & fn & " " & folderN & "\" & fn
     if topF=true then
      objIEx.Document.parentWindow.clipboardData.setData "text",folderN & "\" & fn
      topF=false
     end if
    next
   end if
'   For Each objElement In objIEx.document.all.tags
'    if instr(objElement.name,".")>0  and objElement.checked=true then
'     fn=objElement.name
'if MsgBox(folder & "\" & fn & " to " & folderN & "\" & fn, VbOKCancel) = vbOK  Then WScript.Quit
'     fs.MoveFile folder & "\" & fn, folderN & "\" & fn
'    end if
'   next
   end if
   objIEx.Document.all.move.checked=false
  end if
Loop
logf.close
objIEx.Visible = false
Set objIEx = Nothing

■免責うんぬん
・本VBSによる使用者の損害どうのこうの補償は作成者は一切関知しません
　使用者の責においてご利用ください
質問・要望はこちらからその他WSH,EXCEL VBAの活用例紹介しています

こちらのオークションでプログラミングの書籍を出品してます