楽天ブログ・日記一括削除シェル

楽天ブログ・日記一括削除シェル作ったよWSHとHTMLのGUI活用例

とりあえず最初のページのみ、そのうち全ページできるようにします
その他IE操作自動化、ブラウザにGUI見たいな操作を簡単にさせることができる例です
こちらは表示中のIEの画面を操作するためのVBのソースを生成の適用例です。若干WSH用に修正してます。指定内容を変えたいときは操作コードを出力して、下記のソースを修正してください
■Windows/XP,IE6で動作確認済み
■使いかた
1.拡張子.vbsで適当なファイルを作成する
2.このvbsファイルをエディタで開く
3.下記ソーズをコピー、上記で開いた.vbsのファイルに貼り付ける
4.保存・終了する
5.このvbsファイルを実行（ダブルクリック）
6.IEが起動され、削除対象の文字列を入力する画面が表示される
7."検索キー"の右の入力フィールドに削除したい文字列が含まれるものを入力（タイトル中に個々で指定した文字列を含む日記が削除対象となる）
8."開始"の右のチェックをクリックする→削除動作が開始します

■ソース

Dim objIE0
Dim s
Set objIEx = CreateObject("InternetExplorer.application")
objIEx.Navigate "about:blank"
Do While objIEx.Busy
 WScript.Sleep 100
Loop
objIEx.Width=300 
objIEx.Height=500
objIEx.Visible = true
objIEx.StatusBar = True
objIEx.StatusText = t_date & " htm作成中"
objIEx.ToolBar = false
objIEx.MenuBar = false
objIEx.Document.Write "検索キー:<input name=key><br>"
objIEx.Document.Write "開始:<input type=checkbox name=start><br>"
 Do
  WScript.Sleep 100
  if objIEx.Document.all.start.checked=true then exit do
 Loop
key=objIEx.Document.all.key.value
objIEx.Document.Write "start key=" & key &"<br>"
'対象画面を検索、なければ開く（必要に応じ使用してください）
Set xShell = CreateObject("Shell.Application")
win_s = False
For Each Window In xShell.Windows '対象URLが表示されているか？
 If TypeName(Window.Document) = "HTMLDocument" Then
  if Window.Document.url="http://my.plaza.rakuten.co.jp/?func=diary&act=view" then
   Set objIE0 = Window '対象URLが表示→その画面を使う
   objIEx.Document.Write "Rakuten window already open<br>"
   win_s=true
   exit for
  end if
 end if
next
if win_s=false then '対象URLが非表示→新しく画面を開く
 objIEx.Document.Write "Rakuten window open<br>"
 Set objIE0 = CreateObject("InternetExplorer.Application")
 objIE0.Visible = True
 objIE0.Navigate "http://my.plaza.rakuten.co.jp/?func=diary&act=view"
 call wait_page(objIE0)
end if
'do
' if instr(,key)>0 then
'  objIE0.Navigate "http://my.plaza.rakuten.co.jp/?func=diary&act=view"
'  call wait_page(objIE0)
' end if
'loop
s=objIE0.document.body.innerhtml
s=strmid(s,"<TABLE class=table_line","")
do
 del=false

t=strmid(s,"<TD class=td_paddingLeft align=left>","<")
 objIEx.Document.Write "check title=" & t & "<br>"
 if t="" then  exit do
 if instr(t,key)>0 then
  s=strmid(s,"<A href=""","")
  s=strmid(s,"<IMG","")
  u=strmid(s,"<A href=""",""">")
'objIEx.Document.Write u & "<br>"
'if MsgBox("https://my.plaza.rakuten.co.jp" & u, VbOKCancel, "WS") = vbOK Then WScript.Quit
  u=replace(u,"amp;","")
  objIE0.Navigate "https://my.plaza.rakuten.co.jp" & u
  call wait_page(objIE0)
  objIE0.document.all.tags("INPUT").item(0).Click
  call wait_page(objIE0)
  objIEx.Document.Write "deleted title=" & t & "<br>"
  del=true
  objIE0.Navigate "http://my.plaza.rakuten.co.jp/?func=diary&act=view"
  call wait_page(objIE0)
  s=objIE0.document.body.innerhtml
  s=strmid(s,"<TABLE class=table_line","")
 end if
 'if del=false then exit do
loop
objIEx.Document.Write "done"
function wait_page(objIE0)
 Do While objIE0.busy = True
 Loop
 Do While objIE0.document.readyState <> "complete"
 Loop
end function
Function strmid(org,mae,usiro)
 pos = InStr(org, mae)
 If pos > 0 Then
  strmid = Right(org, Len(org) - pos - Len(mae) + 1)
  org = strmid
  pos = InStr(strmid, usiro)
  If usiro = "" Then
'   strmid = ""
  Else
   If pos > 0 Then
    strmid = Left(strmid, pos - 1)
   End If
  End If
 Else
  strmid = ""
 End If
End Function

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

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