楽天ログインId切替シェル

キャンペーン実施中!日本ファースト証券資料請求でCOCO壱番館500円飲食券を1枚プレゼント
↓より資料請求いただき、こちらのフォームより(1)資料請求日、(2)送付先の住所・お名前を連絡ください

楽天ログインId切替シェル作ったよWSHとHTMLのGUI活用例

楽天ログインId切替をブラウザに一覧表示したIdのクリックで自動化します。複数お持ちでログイン・ログオフが面倒な方ご利用ください
その他IE操作自動化、ブラウザにGUI見たいな操作を簡単にさせることができる例です
こちらは表示中のIEの画面を操作するためのVBのソースを生成の適用例です。若干WSH用に修正してます。指定内容を変えたいときは操作コードを出力して、下記のソースを修正してください
■Windows/XP,IE6で動作確認済み
■使いかた
1.準備：RakutenId.txtの名前でIDとパスワードのファイルを作る
規則は下記の例のように１行ごとにIdとパスワードをスペースで区切り並べる
rakutenId1 passwaord1
raktenid2 password2
2.拡張子.vbsで適当なファイルを作成する
3.このvbsファイルをエディタで開く
4.下記ソーズをコピー、上記で開いた.vbsのファイルに貼り付ける
5.ソース中にユーザID、パスワードを入力。（下記ソースの"←"のコメントのところ）
6.保存・終了する
7.このvbsファイルを実行（ダブルクリック）
8.Id一覧と対応するラジオボタンが表示される
7.切替後のIdをクリックする→現在のIdログオフと選択したIdのログインが行われる
8."終了"のチェックをクリックするとこのシェル終了

■ソース

Dim objIE0
Dim objIE1
Dim s,uid(10),passwd(10)
Const ForReading = 1,ForWriting = 2,ForAppending = 8 '定数の指定
Set Fs = WScript.CreateObject("Scripting.FileSystemObject")
Set oTs1 = Fs.OpenTextFile("RakutenId.txt",ForReading) 'ファイルを読み取りモードで開く"
uid_c=0
Do Until oTs1.AtEndOfStream 'oTs1を末端まで読み込むまでループを繰り返す
 sLine = oTs1.ReadLine '1行読み込む
 uid(uid_c)=left(sLine,instr(sLine," ")-1)
 passwd(uid_c)=right(sLine,len(sLine)-instr(sLine," "))
 uid_c=uid_c+1
Loop
oTs1.Close
Set objIEx = CreateObject("InternetExplorer.application")
objIEx.Navigate "about:blank"
Do While objIEx.Busy
	WScript.Sleep 100
Loop
objIEx.Width=600	
objIEx.Height=500
objIEx.Visible = true
objIEx.StatusBar = True
objIEx.StatusText = t_date & " htm作成中"
objIEx.ToolBar = false
objIEx.MenuBar = false
for i=0 to uid_c - 1
 objIEx.Document.Write "<input type=radio name=uid>" & uid(i) & "<br>"
next
objIEx.Document.Write "終了<input type=checkbox name=quit>" & "<br>"
mae=-1
do
do
 WScript.Sleep 100
 for uid_i=0 to uid_c - 1
  if objIEx.Document.all.quit.checked=true then
   objIEx.Visible = False
   Set objIEx = nothing
   WScript.quit
  end if
  'if objIEx.Document.all.uid.checked=true then
  if objIEx.document.all.tags("INPUT").item(uid_i).checked=true then
   if mae=-1 then
    exit do
   else
    if mae<>uid_i then
     exit do
    end if
   end if
  end if
 next
loop
mae=uid_i
'if MsgBox(i, VbOKCancel, "WS") = vbOK Then WScript.Quit
'対象画面を検索、なければ開く（必要に応じ使用してください）
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://www.rakuten.co.jp/" then
   Set objIE0 = Window '対象URLが表示→その画面を使う
   win_s=true
   exit for
  end if
 end if
next
if win_s=false then '対象URLが非表示→新しく画面を開く
 Set objIE0 = CreateObject("InternetExplorer.Application")
 objIE0.Visible = True
 objIE0.Navigate "http://www.rakuten.co.jp/"
 call waitPage (objIE0)
end if
call link_click(objIE0,"text","ログアウト")
objIE0.Navigate "http://www.rakuten.co.jp/"
call waitPage (objIE0)
do
 if link_click(objIE0,"text","ログイン")<>-1 then exit do
 objIE0.refresh
 call waitPage (objIE0)
loop
objIE0.document.all.u.value=uid(uid_i) ' text index=2
objIE0.document.all.p.value=passwd(uid_i) ' password index=3
objIE0.document.all.auto_logout.click '  checkbox ブラウザを閉じるときオートログインを無効にする
objIE0.document.all.tags("INPUT").item(5).Click 'submit               次へ  
loop
'---header end---
Sub waitPage (objIE0)
 Do While objIE0.busy = True
 Loop
 Do While objIE0.document.readyState <> "complete"
 Loop
End Sub
Function link_click(objIE, typ, v)
link_click = -1
if typ="num" then
 objIE.document.links(v).Click
 Call ie_wait(objIE)
 link_click = 0
else
   For i = 0 To objIE.document.links.Length - 1
   If typ = "text" Then
     If objIE.document.links(i).outertext = v Then
        objIE.document.links(i).Click
        Call waitPage(objIE)
        link_click = 0
        Exit For
     End If
   End If
   If typ = "href" Then
     If objIE.document.links(i).href = v Then
        objIE.document.links(i).Click
        Call waitPage(objIE)
        link_click = 0
        Exit For
     End If
   End If
   If typ = "href_inc" Then
     If InStr(objIE.document.links(i).href, v) > 0 Then
        objIE.document.links(i).Click
        Call waitPage(objIE)
        link_click = 0
        Exit For
     End If
   End If
  Next
end if
End Function

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

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