|
挨拶・自己紹介: | |
|
| |
2012-02-23
XXXXXさんへ IEのタグ表示は、外側を含めた .OuterHTML で 確認すると便利です。
とある三流プログラマーのデバック風景 です。笑ってやってください。
下記の質問をもらいました。
※IDとパスワードは消させてもらいました。
※※株、FX系は、質問いただいてもテストできないから
(テスト結果を出しにくいから敬遠してるんだけど。。。)
'----------------- ここから質問
ログインIDとパスワードと入力する所までは
うまく行くのですが、その後のログインボタンがどうしても押せません。
SubmitとClickを試してみたのですがそれでも駄目でした。
どうかご教授願えませんでしょうか？
以下がコードです。
試して出来なかった没はコメントにしてあります。
Sub test() Dim objIE As Object 'Webページ表示 Set objIE = CreateObject("InternetExplorer.Application") objIE.Visible = True objIE.Navigate "https://sec-sso.click-sec.com/loginweb/" '画面表示待ち While objIE.readyState <> 4 'READYSTATE_COMPLETE = 4 While objIE.Busy = True DoEvents '特に何もしないで.Busyの状態が変わるまで待つ Wend Wend 'テストボックスへ入力 ''画面表示待ち 'Dim time20 As Date ' ' time10 = DateAdd("s", 16, Now) '3秒待ち、三秒後を計算、 ' While Now < time20 '現在時刻が上↑の三秒後以下の間まわる。 ' DoEvents '嫌いな人多いけど、 ' Wend objIE.document.all("j_username").Value = "test dayo" objIE.document.all("j_password").Value = "123456789" 'フォーム(0番目)を .Submit(送信・投稿) またはClickする objIE.document.forms(0).submit 'objIE.document.forms.("LoginForm").submit 'objIE.document.all(LoginForm).Click 'Dim x As Object 'For Each x In objIE.document.forms(0).all ' If TypeName(x) = "HTMLInputElement" Then ' If x.alt = "ログイン" Then ' Call x.Click ' Exit For ' End If ' End If 'Next End Sub
'------- ここまで。
STOP で 止めて、現物を見るのも あきてきたので、
パターン的に探す時、
外側のHTMLを含めて書きだすと わかりやすいと思います。
(※読者心の声: 「そんな方法があるなら先に、ページの頭に書いとけよ」...)
私のサンプルで、InnerTEXTやInnerHTMLが多いのが原因なんだけど、
探る時は、OuterHTML で エレメント・アイテムを探ると便利です。
Youtubeで大きく見る→ http://www.youtube.com/watch?v=QAF0MVqpOgQ
テストで使用したコード
新規のブックに Form(0)だけ書き出してみました(複数フォームに対応しないとなぁ・・・)
Option Explicit Sub test() Dim objIE As Object Set objIE = CreateObject("InternetExplorer.Application") objIE.Visible = True 'Webページ表示 調査したいページを表示する objIE.Navigate "http://www.ken3.org/cgi-bin/test/test027-2.asp" '画面表示待ち While objIE.readyState <> 4 Or objIE.Busy = True 'READYSTATE_COMPLETE = 4 DoEvents '特に何もしないで.Busyの状態が変わるまで待つ Wend '※FORM(0)の下 オブジェクトを１つ１つ表示してみた Dim i As Integer 'カウンター Dim objTAG As Object 'タグのオブジェクト格納用 Workbooks.Add 'テスト用の新規ブックを追加 Range("A1") = "NO.i番目" '見出しのセット Range("B1") = "TypeName関数の結果" Range("C1") = ".TagName タグの名前" Range("D1") = ".OuterHTML 外側含むHTML" Range("E1") = ".Value 値" Range("F1") = ".Name 項目に付けた名前" Columns("A:G").ColumnWidth = 20 '列幅を20に変更 'Form(0)のオブジェクトをFor Each で書き出す i = 0 For Each objTAG In objIE.document.Forms(0) 'データをセルへセットする Cells(i + 2, "A") = i 'i番目 結局iは使うのかよ(笑) Cells(i + 2, "B") = "'" & TypeName(objTAG) 'TypeNameでオブジェクトのタイプを表示 Cells(i + 2, "C") = objTAG.TagName 'タグの名前 Cells(i + 2, "D") = "'" & Left(objTAG.OuterHTML, 256) 'HTML 頭から256文字 Cells(i + 2, "E") = objTAG.Value '値 Cells(i + 2, "F") = objTAG.Name '名前 i = i + 1 'インクリメント Next End Sub
その他、デバック確認は
http://www.ken3.org/cgi-bin/group/vba_ie_form.asp
↑を見て笑ってください。
確認後、修正
ボタンのオブジェクトが
HTMLButtonElement
だったみたいです。(※Inputのチェックが違っていたのと、)
Button は .altが無いので、
Instr関数でOuterHTML内を探してみました。
'フォーム(0番目)を .Submit(送信・投稿) またはClickする Dim x As Object For Each x In objIE.document.Forms(0) If TypeName(x) = "HTMLButtonElement" Then Debug.Print x.OuterHTML If InStr(x.OuterHTML, "alt=ログイン") > 0 Then Call x.Click Exit For End If End If Next
に変更すると、動作すると思います。
証券会社のページは、自動ログイン除けとかあるので大変だと思いますが....
終わりの挨拶
原因は、
質問者が参考にした三流プログラマーのHP
が探しにくいからなぁ。
(※読者心の声で 「だったら、探しやすく・見やすくしろよ」と聞こえて所で逃げるように失礼します。)
デバック処理の参考となれば幸いです。
Permalink | コメント(0) | トラックバック(0) | 07:48
2012-02-22
XXXXXさんへ Outlook VBA メニュー・コマンド から すべて送受信を探し 実行
アウトルックで下記の質問をいただきました。
>EXCELのVBAでOutLookを起動し未受信のメールをサーバーから受信した後に
>未読のメールをエクセルに転記、その後OutLookを終了するVBAを作りたいの
>ですが、
>起動後のOutLookでメールサーバから自動的に新規メールを受信する
>部分ができません。
起動後に受信したいので、
送受信のコマンドを実行させてみます。と思ったら、
追記 .Session.SendAndReceive(True) で 送信OKと連絡をもらう
質問者自身から別回答をもらってしまった（笑）
>
>OutLook に SendAndReceive メソッドが有ったのでもしやと思い
>Rtn = oApp.Session.SendAndReceive(True)
> を Excel VBA で実行させたところできました。
>
↑でできたので、ここから下、お蔵入り(そのまま恥を残しておきますね)
ツール → 送受信 → すべて送受信
のコマンドを実行させてみます。
コマンドの処理は、
未完成の署名を選択するプログラム
http://ken3-info.blog.ocn.ne.jp/day/2009/02/22_vba_outlook_4a33.html
で使っていた
As Office.CommandBars
を 参考に探ってみます。
これはひどい 自分語脳内垂れ流し動画
下記、解説と言えない、これはひどい 自分語 脳内垂れ流し動画です。
Youtubeで大きく見る→ Outlook VBA As Office.CommandBar から 送受信を探し .Execute で実行 - YouTube
これはひどい、ひどすぎる 三流コード
これぞ三流コード、If文のネストがひどすぎです(ぉぃぉぃ)
Sub test_CommandBar_a() Dim n As Integer 'Outlook 一番外側のメニュー Dim i As Integer 'Menu Barのループ Dim j As Integer 'ツール メニューのループ Dim k As Integer '送受信 メニューのループ Dim cbMENU As Office.CommandBar 'メニューバー Dim cbTOOL As Office.CommandBarPopup 'ツールのメニュー Dim cbSEND As Office.CommandBarPopup '送受信のメニュー For n = 1 To Application.ActiveExplorer.CommandBars.Count 'Outlookのメニュー Debug.Print n, Application.ActiveExplorer.CommandBars.Item(n).Name If Application.ActiveExplorer.CommandBars.Item(n).Name = "Menu Bar" Then 'Menu Barを探す Set cbMENU = Application.ActiveExplorer.CommandBars.Item(n) '見つかったので変数にセット For i = 1 To cbMENU.Controls.Count '↑上でセットした、Menu Barの中を探す Debug.Print i, cbMENU.Controls(i).Caption If cbMENU.Controls(i).Caption = "ツール(&T)" Then 'ツールを探す Set cbTOOL = cbMENU.Controls(i) '見つかったので変数にセット For j = 1 To cbTOOL.Controls.Count '次は↑で見つけたツールの中から送受信を探す Debug.Print j, cbTOOL.Controls(j).Caption If cbTOOL.Controls(j).Caption = "送受信(&E)" Then '送受信か？ Set cbSEND = cbTOOL.Controls(j) '見つかったのでまたまた変数にセット For k = 1 To cbSEND.Controls.Count '最後に↑送受信の中から すべて送受信を探す Debug.Print k, cbSEND.Controls(k).Caption If cbSEND.Controls(k).Caption = "すべて送受信(&A)" Then 'やっと見つけたか？ 'コマンドの実行 .Executeで実行する cbSEND.Controls(k).Execute '見つけたコマンド実行 Exit For '見つけたので送受信のループを抜ける End If Next k Exit For 'ツールのループを抜ける End If Next j Exit For 'Menu Barのループを抜ける End If Next i Exit For '大外 Outlook コマンドバー の ループを抜ける End If Next n End Sub
コードのポイントは、
送受信のコマンドを実行させたかったので、
ActiveExplorer.CommandBars
から、ツールを探し、
次に、
.CommandBar から 送受信を探す、
さらに
.CommandBarPopup から すべて送受信を探しだし、
.Execute で実行 してみました。
※↑と、馬鹿みたいに 上から 探してみました（笑）
上から順番に探すなら・・・少しひどいコード
上から順番にループで探しているだけなので、
ブロック単位に分けて、存在チェックを入れながら探してみました。
'メニューから 全て送受信を探し、実行する Sub test_CommandBar_b() Dim n As Integer 'ループのカウンタ Dim cbMENU As Office.CommandBar 'メニューバー 格納用 Dim cbTOOL As Office.CommandBarPopup 'ツールのメニュー 格納用 Dim cbSEND As Office.CommandBarPopup '送受信のメニュー 格納用 Dim ctlSENDALL As Office.CommandBarControl 'すべてを送受信、コントロール格納用 'Outlookの全体メニュー Application.ActiveExplorer.CommandBars からMenu Barを探す Set cbMENU = Nothing 'まず、Menu Bar格納用の変数を空にする For n = 1 To Application.ActiveExplorer.CommandBars.Count 'Outlookのコマンドバーの数ループ Debug.Print n, Application.ActiveExplorer.CommandBars.Item(n).Name '名前(.Name)がMenu Barのアイテム(Item(n番目))を探し、格納用変数に代入する If Application.ActiveExplorer.CommandBars.Item(n).Name = "Menu Bar" Then 'Menu Barを探す Set cbMENU = Application.ActiveExplorer.CommandBars.Item(n) '見つかったので変数にセット Exit For '大外 Outlook コマンドバー の ループを抜ける End If Next n '↑で見つかったか？変数にセットされているかで判断する If cbMENU Is Nothing Then '中身がなければ(Nothingなら) MsgBox "Menu Barが見つかりません" Exit Sub '↑メッセージを表示して関数を抜ける End If '次に↑で見つけた、Menu Bar から ツールを探す Set cbTOOL = Nothing 'ツールのメニューバーをNothingで初期化 For n = 1 To cbMENU.Controls.Count 'Menu Barの中を探す Debug.Print n, cbMENU.Controls(n).Caption '表題(.Caption)がツールのアイテム(.Controls(n番目))を探し、格納用変数に代入する If cbMENU.Controls(n).Caption = "ツール(&T)" Then 'ツールを探す Set cbTOOL = cbMENU.Controls(n) '見つかったのでツール格納用変数にセット Exit For '↑代入後、Menu Barのループを抜ける End If Next n '↑で見つかったか？変数にセットされているかで判断する If cbTOOL Is Nothing Then '中身がなければ(Nothingなら) MsgBox "ツールメニューが見つかりません" Exit Sub '↑メッセージを表示して関数を抜ける End If '次は ツール(cbTOOL)の中から 送受信を探します Set cbSEND = Nothing '変数を初期化 For n = 1 To cbTOOL.Controls.Count '↑で見つけたツールの中から送受信を探す Debug.Print n, cbTOOL.Controls(n).Caption '表題(.Caption)が送受信のアイテム(.Controls(n番目))を探し、格納用変数に代入する If cbTOOL.Controls(n).Caption = "送受信(&E)" Then '表題が送受信か？ Set cbSEND = cbTOOL.Controls(n) '見つかったのでn番目をまたまた変数にセット Exit For 'ツールのループを抜ける End If Next n '↑で見つかったか？変数にセットされているかで判断する If cbSEND Is Nothing Then '中身がなければ(Nothingのまま) MsgBox "送受信のメニューが見つかりません" Exit Sub '↑メッセージを表示して関数を抜ける End If 'やっと、↑送受信から、すべてを送受信 を 探す Set ctlSENDALL = Nothing 'コントロールの変数を初期化する For n = 1 To cbSEND.Controls.Count '最後に↑送受信の中から すべて送受信を探す Debug.Print n, cbSEND.Controls(n).Caption '表題(.Caption)がすべて送受信のアイテム(.Controls(n番目))を探し、格納用変数に代入する If cbSEND.Controls(n).Caption = "すべて送受信(&A)" Then 'やっと見つけたか？ Set ctlSENDALL = cbSEND.Controls(n) 'みつけたn番目のコントロールをセットする Exit For '見つけたので送受信のループを抜ける End If Next n If ctlSENDALL Is Nothing Then '中身がなければ(Nothingのまま) MsgBox "すべて送受信のコントロールが見つかりません" Exit Sub '↑メッセージを表示して関数を抜ける End If 'やっとセットされたコントーる(みつけたコマンド)を .Executeで実行する ctlSENDALL.Execute 'コントロール.Executeで実行 'お疲れちゃん の 変数たちを解放する Set ctlSENDALL = Nothing Set cbSEND = Nothing Set cbTOOL = Nothing Set cbMENU = Nothing End Sub
↑少しは、ましになったけど、まだまだだなぁ。
そんな 少しひどい コードでした。
※プロなら、再帰処理を使って、スマートに書けよ・・・と言われそうですが。。。
Item("名前") Controls("名前") で 参照できた(（笑）)
の
Sub cmdPrint_Click()
Item.GetInspector.CommandBars.Item("Menu Bar").Controls("File") _
.Controls("Print...").Execute
End Sub
で、できますね（笑）
※頭から探していた 自分が恥ずかしかったり(ぉぃぉぃ)
終わりの挨拶
またまた、やっちまったなぁ感のある
脳内 自分語 垂れ流し の 解説動画とコードでした。
もしかして、参考元の
http://ken3-info.blog.ocn.ne.jp/day/2009/02/22_vba_outlook_4a33.html
↑こっちで 1 からTo 35000 件 総当たりで .FindControlのほうがスッキリしてたかも？
※まぁ、ドッチもダメですが。
正解の 再帰処理でスマートに多重階層を処理しろよ・・・と、
読者の声が聞こえたところで、逃げるように失礼します。
何かの参考となれば(反面教師となれば)幸いです。 三流プログラマー Ken3
2012-02-22 追記
忘れてた、質問は、
>EXCELのVBAでOutLookを起動し未受信のメールをサーバーから受信した後に
>未読のメールをエクセルに転記、その後OutLookを終了するVBAを作りたいの
>ですが、
>起動後のOutLookでメールサーバから自動的に新規メールを受信する
>部分ができません。
Excelからのコントロールだった。
下記、頭に Outlookの起動を入れただけのコード。
Option Explicit 'Outlookを起動後、メニューから 全て送受信を探し、実行する Sub test_Outlook_sendall() 'Outlookの起動 Dim oApp As Object 'As Outlook.Application OutlookのApplication オブジェクトを入れる Dim myNameSpace As Object 'As Outlook.NameSpace 名前のスペースと言われても、、 Dim myFolder As Object 'As Outlook.Folder フォルダー指定 'outlook 起動をCreateObjectで ※これだと複数起動してしまうがご勘弁を Set oApp = CreateObject("Outlook.Application") '呪文１ 名前空間 の 指定 と言っても、.GetNamespace("MAPI")しただけ Set myNameSpace = oApp.GetNamespace("MAPI") '次は作業フォルダーの指定(.GetDefaultFolder) と 表示(.Display) Set myFolder = myNameSpace.GetDefaultFolder(6) '規定のフォルダー olFolderInbox=6 指定 myFolder.Display '表示 いつものクセで .Visible = True とやりがちだけど '通常サイズ olNormalWindow=2 で表示(ほかに olMaximized=0,olMinimized=1) oApp.ActiveWindow.WindowState = 2 'olNormalWindow=2 を セット 'ここから、メニュー・コマンドバーを探り、すべて送受信を実行する Dim n As Integer 'ループのカウンタ Dim cbMENU As Object 'As Office.CommandBar 'メニューバー 格納用 Dim cbTOOL As Object 'As Office.CommandBarPopup 'ツールのメニュー 格納用 Dim cbSEND As Object 'As Office.CommandBarPopup '送受信のメニュー 格納用 Dim ctlSENDALL As Object 'As Office.CommandBarControl 'すべてを送受信、コントロール格納用 'Outlookの全体メニュー Application.ActiveExplorer.CommandBars からMenu Barを探す Set cbMENU = Nothing 'まず、Menu Bar格納用の変数を空にする For n = 1 To oApp.ActiveExplorer.CommandBars.Count 'oapp で Outlookのコマンドバー参照 Debug.Print n, oApp.ActiveExplorer.CommandBars.Item(n).Name '名前(.Name)がMenu Barのアイテム(Item(n番目))を探し、格納用変数に代入する If oApp.ActiveExplorer.CommandBars.Item(n).Name = "Menu Bar" Then 'Menu Barを探す Set cbMENU = oApp.ActiveExplorer.CommandBars.Item(n) '見つかったので変数にセット Exit For '大外 Outlook コマンドバー の ループを抜ける End If Next n '↑で見つかったか？変数にセットされているかで判断する If cbMENU Is Nothing Then '中身がなければ(Nothingなら) MsgBox "Menu Barが見つかりません" Exit Sub '↑メッセージを表示して関数を抜ける End If '次に↑で見つけた、Menu Bar から ツールを探す Set cbTOOL = Nothing 'ツールのメニューバーをNothingで初期化 For n = 1 To cbMENU.Controls.Count 'Menu Barの中を探す Debug.Print n, cbMENU.Controls(n).Caption '表題(.Caption)がツールのアイテム(.Controls(n番目))を探し、格納用変数に代入する If cbMENU.Controls(n).Caption = "ツール(&T)" Then 'ツールを探す Set cbTOOL = cbMENU.Controls(n) '見つかったのでツール格納用変数にセット Exit For '↑代入後、Menu Barのループを抜ける End If Next n '↑で見つかったか？変数にセットされているかで判断する If cbTOOL Is Nothing Then '中身がなければ(Nothingなら) MsgBox "ツールメニューが見つかりません" Exit Sub '↑メッセージを表示して関数を抜ける End If '次は ツール(cbTOOL)の中から 送受信を探します Set cbSEND = Nothing '変数を初期化 For n = 1 To cbTOOL.Controls.Count '↑で見つけたツールの中から送受信を探す Debug.Print n, cbTOOL.Controls(n).Caption '表題(.Caption)が送受信のアイテム(.Controls(n番目))を探し、格納用変数に代入する If cbTOOL.Controls(n).Caption = "送受信(&E)" Then '表題が送受信か？ Set cbSEND = cbTOOL.Controls(n) '見つかったのでn番目をまたまた変数にセット Exit For 'ツールのループを抜ける End If Next n '↑で見つかったか？変数にセットされているかで判断する If cbSEND Is Nothing Then '中身がなければ(Nothingのまま) MsgBox "送受信のメニューが見つかりません" Exit Sub '↑メッセージを表示して関数を抜ける End If 'やっと、↑送受信から、すべてを送受信 を 探す Set ctlSENDALL = Nothing 'コントロールの変数を初期化する For n = 1 To cbSEND.Controls.Count '最後に↑送受信の中から すべて送受信を探す Debug.Print n, cbSEND.Controls(n).Caption '表題(.Caption)がすべて送受信のアイテム(.Controls(n番目))を探し、格納用変数に代入する If cbSEND.Controls(n).Caption = "すべて送受信(&A)" Then 'やっと見つけたか？ Set ctlSENDALL = cbSEND.Controls(n) 'みつけたn番目のコントロールをセットする Exit For '見つけたので送受信のループを抜ける End If Next n If ctlSENDALL Is Nothing Then '中身がなければ(Nothingのまま) MsgBox "すべて送受信のコントロールが見つかりません" Exit Sub '↑メッセージを表示して関数を抜ける End If 'やっとセットされたコントーる(みつけたコマンド)を .Executeで実行する ctlSENDALL.Execute 'コントロール.Executeで実行 'お疲れちゃん の 変数たちを解放する Set ctlSENDALL = Nothing Set cbSEND = Nothing Set cbTOOL = Nothing Set cbMENU = Nothing End Sub
Permalink | コメント(1) | トラックバック(0) | 01:22
2012-02-19
XXXXさんへ VBAでn秒待つには
こんにちは。
下記の質問をいただきました。
>３．開いた文章 Document に アクセスするの章の中の「'手抜きで2秒待つ(オブジェクトの展開時間を待つ)
>Application.Wait Time:=Now + TimeValue("00:00:02") '2秒間 ボーっとする」という部分でエラーが出てすすめません。
>コンパイルエラーはメソッドまたはデータメンバが見つかりませんと出たので参照設定にてMicrsoft Excel 11.0 Object Libraryも
>追加してみたのですが、それでも出ます。
他の人からも(質問・クレーム(ぉぃぉぃ))もらっていたり（笑）
QA20110912 アウトルック 終了時の未送信確認メッセージを何とかしたい - ken3memo (三流君)
や ほか多数。
私のExcelでしか使えないサンプルが、ご迷惑をおかけしてすみません。
と先に謝っといて、
前置き、謝罪は、置いといて、
三流CODEのゴミ箱: AccessでExcelのApplication.Wait Time:=Now + TimeValue(”00:00:02”)
http://ken3-info.blog.ocn.ne.jp/code_gomibako/2009/10/accessexcelappl.html
1つ日時の変数作成して、
Dim time10 As Date time10 = DateAdd("s", 3, Now) '3秒待ち、三秒後を計算、 While Now < time10 '現在時刻が上↑の三秒後以下の間まわる。 DoEvents '嫌いな人多いけど、 Wend
みたいな感じで、DateAddでn秒後を計算、
あとは、今の時刻 < 計算した時刻 の間、空ループって感じかなぁ。
(※読み替えると、現在時刻が計算した時刻を越えるまでループかなぁ？)
何かの参考となれば、幸いです。 三流プログラマー Ken3
※ AccessやOutlookで Application.Wait が 無いなんて、、まぁApplication.の下だから共通じゃないのか。
Permalink | コメント(0) | トラックバック(0) | 07:10
.