VBAでIEを操作する方法について見識がある方にお伺いします。お気持ちのみですが合計200P程。

IEでダウンロードボタンを押す方法について教えて下さい。

今、以下のformをsubmitすると、alert無しで「ファイルのダウンロード」ダイアログが出ます。
<form action="https:****.co.jp" method="post" name="printItems" target="_blank">
・・・
</form>
formをsubmitし、開くダイアログボックスを補ていするまではプログラムできました。
この後、「開く(O)」「保存(S)」「キャンセル」のうち「保存(S)」をクリックしたいのですが、コメント欄に示すプログラムではうまくいきません。方法を教えて頂けませんでしょうか。

尚、以下のページを参考にしています。

参考:PostMessageのパラメータの説明
http://yokohama.cool.ne.jp/chokuto/urawaza/api/PostMessage.html
参考:IE7「ファイルのダウンロード」のクリック
http://hpcgi1.nifty.com/MADIA/VBBBS/wwwlng.cgi?print+200901/09010002.txt

回答の条件
  • 1人2回まで
  • 13歳以上
  • 登録:2010/09/29 10:29:15
  • 終了:2010/10/05 15:28:03

ベストアンサー

id:ko8820 No.2

ko8820回答回数1221ベストアンサー獲得回数692010/09/29 21:50:22

ポイント150pt

'親ウィンドウ取得

strCaption = "ファイルのダウンロード"

pWnd = FindWindowEx(0, 0, vbNullString, strCaption)

'保存ボタンのハンドル

cWnd = FindWindowEx(pWnd, 0&, "Button", "保存(&S)")

pWndがNULLかどうかをまず確認しましょう。

ウインドウハンドルがうまく取得できてない可能性があります。

strCaption にはウインドウの名前が入りますから、IEやOSのバージョンによって変わりますよ。

次にボタンのハンドルcWnd がちゃんと取得できてることを確認してください。

もし、確認してたらごめんなさい。

Sendkeyをつかっても、結局は同じようなソースになりますね。

http://oshiete.goo.ne.jp/qa/1809850.html

id:ReoReo7

ありがとうございます。Sendkeyを使って機能実現したのですが、恐らくPCの性能?によってSendkeys ** , Trueとその次の命令をつなぐ間のウェイト時間を調整しなければならないので、性能の悪いPCだとこれって動かないプログラムだよなぁ?みたいなことを考えながらコーディングしなければなりませんでした。ご教示頂いた方法も参考にしてみます!(とりあえずSendkeysでやってみようかな。。。)

追記:SendKeysでできました。

ただ、これだといくつか問題が出ます。具体的には、IEのReadyStateがCOMPLETEではなくINTERACTIVEのままになったり(条件は忘れました。ダイアログボックスを実行後次のページに進むときに問題になるんだったかな・・・)、ダイアログボックスの決定の際にWaitで見積り時間をエイヤで決めて余裕を持ってプログラム動作させなければいけないことです。

やっぱりSendKeysではなくてボタンをしっかり制御できるように教えて頂いた方法で改良していくことが肝要のようですね。。

あっでも「ウインドウハンドルがうまく取得できてない可能性がある」と「ウィンドウキャプションはIEのバージョン依存」の問題があるのか。後者はともかく、前者は時間ごとに定期的に取得しにいって、必ずループを抜ける処理にならないとSendKeysと変わりないですね。。

更に追記:「IEのReadyStateがCOMPLETEではなくINTERACTIVEのままになったり」←この問題は、ダイアログボックス出現前のobjIE.hWndを記録しておいて、ダイアログボックス入力後に戻すことで解決可能かも。

2010/09/30 19:09:48

その他の回答(1件)

id:taknt No.1

きゃづみぃ回答回数13539ベストアンサー獲得回数11982010/09/29 10:38:24

ポイント50pt

私は どこからか拾ってきた以下のやり方で ボタンを クリックさせてます。

が、たまーーに 反応しないときがあるようで・・・。

    Dim objINPUT As Object   'Inputタグ格納用

    For Each objINPUT In objIE.document.all.tags("INPUT")  'Inputのタグを.allから抜く
        If objINPUT.Value = "ログイン" Then
            objINPUT.Click  '見つけたINPUTオブジェクト(ボタン)を.Clickクリックする
            Exit For  '用が済んだので(見つかったので)ループを抜ける
        End If
    Next
id:ReoReo7

いつもありがとうございます。

ken3memoさんのプログラムですね。

ありがとうございます、書き忘れてしまったので申し訳ないのですが、コメント欄にプログラムを書いてあります。そこでは、clickするまではできたのですが、ダイアログボックスのボタンを押すのに苦戦中、ということを書いています。質問が言葉足らずで申し訳ありませんです。

2010/09/29 10:42:36
id:ko8820 No.2

ko8820回答回数1221ベストアンサー獲得回数692010/09/29 21:50:22ここでベストアンサー

ポイント150pt

'親ウィンドウ取得

strCaption = "ファイルのダウンロード"

pWnd = FindWindowEx(0, 0, vbNullString, strCaption)

'保存ボタンのハンドル

cWnd = FindWindowEx(pWnd, 0&, "Button", "保存(&S)")

pWndがNULLかどうかをまず確認しましょう。

ウインドウハンドルがうまく取得できてない可能性があります。

strCaption にはウインドウの名前が入りますから、IEやOSのバージョンによって変わりますよ。

次にボタンのハンドルcWnd がちゃんと取得できてることを確認してください。

もし、確認してたらごめんなさい。

Sendkeyをつかっても、結局は同じようなソースになりますね。

http://oshiete.goo.ne.jp/qa/1809850.html

id:ReoReo7

ありがとうございます。Sendkeyを使って機能実現したのですが、恐らくPCの性能?によってSendkeys ** , Trueとその次の命令をつなぐ間のウェイト時間を調整しなければならないので、性能の悪いPCだとこれって動かないプログラムだよなぁ?みたいなことを考えながらコーディングしなければなりませんでした。ご教示頂いた方法も参考にしてみます!(とりあえずSendkeysでやってみようかな。。。)

追記:SendKeysでできました。

ただ、これだといくつか問題が出ます。具体的には、IEのReadyStateがCOMPLETEではなくINTERACTIVEのままになったり(条件は忘れました。ダイアログボックスを実行後次のページに進むときに問題になるんだったかな・・・)、ダイアログボックスの決定の際にWaitで見積り時間をエイヤで決めて余裕を持ってプログラム動作させなければいけないことです。

やっぱりSendKeysではなくてボタンをしっかり制御できるように教えて頂いた方法で改良していくことが肝要のようですね。。

あっでも「ウインドウハンドルがうまく取得できてない可能性がある」と「ウィンドウキャプションはIEのバージョン依存」の問題があるのか。後者はともかく、前者は時間ごとに定期的に取得しにいって、必ずループを抜ける処理にならないとSendKeysと変わりないですね。。

更に追記:「IEのReadyStateがCOMPLETEではなくINTERACTIVEのままになったり」←この問題は、ダイアログボックス出現前のobjIE.hWndを記録しておいて、ダイアログボックス入力後に戻すことで解決可能かも。

2010/09/30 19:09:48
  • id:ReoReo7
    objIE.document.forms("printItems").target= ""
    objIE.document.forms("printItems").Submit

    'VBAからではなく、ページ中のスクリプトで押させる

    '次のjavascriptの意味は実は良くわかっていませんがとりあえずできました。。
    objIE.Document.Script.setTimeout "javascript:document.forms('printItems').Item('printItems').submit()", 6000

    'ダイアログが表示されるまで待機
    Do
    Sleep (200)
    lngDHnd = GetLastActivePopup(objIE.hWnd)
    Loop While lngDHnd = objIE.hWnd

    '===================================================================
    'ここでlngDHndに数字を入れるところまではできました。以下がうまくいきません。
    'OK/NGの2択のダイアログボックスじゃないから?
    '===================================================================
    'OKボタンを押す
    Const WM_COMMAND = &H111
    Dim lngRc As Long
    lngRc = PostMessage(lngDHnd, WM_COMMAND, 1, 0)
    '===================================================================
  • id:ReoReo7
    ちなみに、その後に出てくる保存先する場所とファイル名も任意に変えて保存して、コントロールをIEに戻したいのですが、それも分かるならばお願いします。保存する場所は最悪デフォルトでも構いません。
  • id:ReoReo7
    もうちょっと言うと、formをsubmitしてもサーバーがビジーで失敗することもあるので、formのtargetの_blankをそのままにしておいて、新規ウィンドウでポップアップがあれば保存、新規ウィンドウで2秒待ってポップアップが無ければ新規ウィンドウを閉じてリトライ(再びformをsubmit)したいのですが、これは今の質問が解決したら別の質問でやろうかと考えています。。
  • id:taknt
    すみません、ちょっと 質問の意味を取り違えてました。

    http://officetanaka.net/excel/vba/statement/SendKeys.htm

    ダイアログのボタンを押す場合 DDEとかじゃないとほかは SendKeysしかないと思います。
  • id:ReoReo7
    DDEを調べてみましたが、よく分かりませんでした。DDEとは一言で言うと何でしょう?

    良く見るOK/キャンセルの2択のダイアログボックスでは、1つめのコメントのプログラムでOKが押せるみたいです。

    確かに、ポップアップが出てくるかどうかだけ待って、ポップアップを確認した時点で
    SenKeysで [Alt]+[S] → ファイル名をSenKeysで入力 → SenKeysで [Alt]+[S] → ダウンロードが終わるまでの必要十分な時間waitしてから SenKeysで [Enter]
    としたほうが良いのかもしれませんね・・・。やっぱりそれしかないですかね?
  • id:taknt
    あ、今は DDEじゃなくて OLEなのかな。

    http://www.site-cooler.com/kwl/perl/ole.htm

    SenKeysの場合、実行中は ほかの操作ができないのが 難点なんですよねぇ。

    ま、それしかないといえば しょうがないですけど。

  • id:ReoReo7
    ありがとうございます!
    うーん、やっぱりSendkeysですか。一応仮に作り上げてみましたが、一応用を足しているようです。
    おかげさまで、動作が全然できないよりかかなり前進できました♪
  • id:Silvanus
    http://www.ne.jp/asahi/hishidama/home/tech/vcpp/clickdlg.html
    私も以上の様なサイトを参考にしてトライしてみましたが、全く上手く行かず…。
    FindWindow(Ex)関数からして何だか期待通りに動作していなさそうな感じ
    (私の使い方が間違っている可能性大)なので、力業で代用してみたりと
    いろいろやって何とか出来上がった糞マクロが下のもの。
    一応動きますけど、やっぱりかなりの長さのウェイト(下の例ではメチャ長にしてます)が
    必要な様でダメダメな感じ。何とかならないものでしょうかね…。
    ということで、ご質問に乗っからせていただきます。
    達人の方、宜しくお願いいたします!
    '
    Option Explicit
    '
    Private Declare Function EnumWindows Lib "user32" _
    (ByVal lpEnumFunc As Long, _
    ByVal lParam As Long) As Long
    Private Declare Function EnumChildWindows Lib "user32" _
    (ByVal hWndParent As Long, _
    ByVal lpEnumFunc As Long, _
    ByVal lParam As Long) As Long
    Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" _
    (ByVal hWnd As Long, _
    ByVal lpClassName As String, _
    ByVal nMaxCount As Long) As Long
    Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
    (ByVal hWnd As Long, _
    ByVal lpString As String, _
    ByVal nMaxCount As Long) As Long
    Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" _
    (ByVal hWnd As Long, _
    ByVal Msg As Long, _
    ByVal wParam As Long, _
    lParam As Any) As Long
    Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" _
    (ByVal hWnd As Long, _
    ByVal Msg As Long, _
    ByVal wParam As Long, _
    lParam As Any) As Long
    Private Declare Function SetFocus Lib "user32" _
    (Optional ByVal hWnd As Long) As Long
    Private Declare Function Sleep Lib "kernel32" _
    (ByVal dwMilliseconds As Long)
    Private Declare Function SleepEx Lib "kernel32" _
    (ByVal dwMilliseconds As Long, _
    ByVal bAlertable As Boolean) As Long
    Private Const BM_CLICK = &HF5
    Private Const WM_SETTEXT = &HC
    '
    Private Const LNGWaitMSec1 As Long = 1000
    Private Const LNGWaitMSec2 As Long = 5000
    Private Const INTNRetryFindDlg As Integer = 3
    '
    Private strDlgTarget As String ' 検索するダイアログの名称
    Private strCtrlTarget As String ' 検索するコントロールの名称
    ' or クラス名(1文字目を半角空白に、その後にクラス名を続ける)
    Private hDlgTarget As Long ' 発見されたダイアログのハンドル
    Private hCtrlTarget As Long ' 発見されたコントロールのハンドル
    '
    Sub Hatena_100930()
    '
    Const STRDlgFlDwnld As String = "ファイルのダウンロード"
    Const STRBtnFlDwnldSave As String = "保存(&S)"
    Const STRDlgSaveAs As String = "名前を付けて保存"
    Const STRBtnSaveAsSave As String = "保存(&S)"
    Const STREditCtrlFlName As String = " Edit" ' クラス名検索
    Const STRSaveFileName As String = "D:\Hatena\HatenaTest.lzh"
    '
    Dim lngRtnVal As Long
    Dim strVSaveFileName As String
    Dim objAppIE As Object
    '
    Set objAppIE = CreateObject("InternetExplorer.Application")
    objAppIE.Visible = True
    objAppIE.Navigate "http://XXX.YYY/ZZZ/Test.lzh"
    '
    If Not SearchDlgCtrl(STRDlgFlDwnld, STRBtnFlDwnldSave) Then
    MsgBox "Failure 1." '「保存」ボタンの検索失敗 → 終了
    Exit Sub
    End If
    lngRtnVal = SetFocus(hDlgTarget)
    lngRtnVal = SleepEx(LNGWaitMSec2, True)
    lngRtnVal = PostMessage(hCtrlTarget, BM_CLICK, 0, 0)
    '

    If Not SearchDlgCtrl(STRDlgSaveAs, STREditCtrlFlName) Then
    MsgBox "Failure 2." '「ファイル名」エディットの検索失敗 → 終了
    Exit Sub
    End If
    lngRtnVal = SetFocus(hDlgTarget)
    lngRtnVal = SleepEx(LNGWaitMSec1, True)
    strVSaveFileName = STRSaveFileName
    lngRtnVal = SendMessage(hCtrlTarget, WM_SETTEXT, 0, ByVal strVSaveFileName)
    '
    If Not SearchDlgCtrl(STRDlgSaveAs, STRBtnSaveAsSave) Then
    MsgBox "Failure 3." '「保存」ボタンの検索失敗 → 終了
    Exit Sub
    End If
    lngRtnVal = SetFocus(hDlgTarget)
    lngRtnVal = SleepEx(LNGWaitMSec1, True)
    lngRtnVal = PostMessage(hCtrlTarget, BM_CLICK, 0, 0)
    ' 同名ファイル存在のケースは未想定
    '
    End Sub
    '
    Function SearchDlgCtrl(strNameDlg As String, strNameCtrl As String) As Boolean
    '
    Dim intCountL As Integer
    Dim lngRtnVal As Long
    '
    strDlgTarget = strNameDlg
    strCtrlTarget = strNameCtrl
    intCountL = 0
    hCtrlTarget = 0
    Do
    lngRtnVal = SleepEx(LNGWaitMSec1, True)
    lngRtnVal = EnumWindows(AddressOf EnumWindowsProc, 0) ' ウインドウ列挙/ハンドル受取
    intCountL = intCountL + 1
    Loop While (intCountL < INTNRetryFindDlg) And (hCtrlTarget = 0)
    If hCtrlTarget = 0 Then
    SearchDlgCtrl = False
    Else
    SearchDlgCtrl = True
    End If
    '
    End Function

    '
    Public Function EnumWindowsProc(ByVal hWnd As Long, ByVal lParam As Long) As Long ' トップレベルウィンドウ 列挙/ハンドル受取
    '
    Dim lpClassName As String * 128
    Dim strClassName As String
    Dim lpWindowText As String * 512
    Dim strWindowText As String
    Dim lngRtnVal As Long
    '
    lngRtnVal = GetWindowText(hWnd, lpWindowText, Len(lpWindowText))
    strWindowText = Left(lpWindowText, InStr(lpWindowText, vbNullChar) - 1)
    If strWindowText = strDlgTarget Then
    hDlgTarget = hWnd
    lngRtnVal = EnumChildWindows(hWnd, AddressOf EnumChildWindowsProcSpecial, lParam)
    End If
    EnumWindowsProc = True
    '
    End Function
    '
    Private Function EnumChildWindowsProcSpecial(ByVal hWnd As Long, ByVal lParam As Long) As Long ' 子ウィンドウ 列挙/ハンドル受取
    '
    Dim lpClassName As String * 128
    Dim strClassName As String
    Dim lpWindowText As String * 512
    Dim strWindowText As String
    Dim lngRtnVal As Long
    '
    If Left(strCtrlTarget, 1) = " " Then
    lngRtnVal = GetClassName(hWnd, lpClassName, Len(lpClassName))
    strClassName = Left(lpClassName, InStr(lpClassName, vbNullChar) - 1)
    If strClassName = Mid(strCtrlTarget, 2) Then
    hCtrlTarget = hWnd
    End If
    Else
    lngRtnVal = GetWindowText(hWnd, lpWindowText, Len(lpWindowText))
    strWindowText = Left(lpWindowText, InStr(lpWindowText, vbNullChar) - 1)
    If strWindowText = strCtrlTarget Then
    hCtrlTarget = hWnd
    End If
    End If
    EnumChildWindowsProcSpecial = True
    '
    End Function
  • id:cx20
    解決済みのようですが、参考まで。

    外部アプリを使用してもよいのであれば UWSC + IE を試してみてはいかがでしょうか?

    VBA で Win32 API を直接呼び出すという方法もありますが、コードが長くなる傾向にあります。
    UWSC は Windows 自動化操作をスクリプト化することができ自動化の為の関数も多く用意されてます。

    <参考情報>
    ■ UWSCでIEを自動操作し,回帰テスト/JavaScript実行/ファイル保存 などができるライブラリ - 主に言語とシステム開発に関して
    http://d.hatena.ne.jp/language_and_engineering/20090825/p1
    ■ UWSC 基礎文法最速マスター - CX's UWSC Diary - UWSCグループ
    http://uwsc.g.hatena.ne.jp/cx20/20100131/1264938584

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません