ReoReo7回答ポイント 200ptウォッチ

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

• はてなアカウントでログイン
• 無料ユーザー登録

ベストアンサー

• ko88202010/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

  スター

  • ReoReo7 2010/09/30 19:09:48

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

    追記：SendKeysでできました。

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

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

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

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

その他の回答

• きゃづみぃ2010/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
  

  スター

  • ReoReo7 2010/09/29 10:42:36

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

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

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

この質問へのコメント

• ReoReo72010/09/29 10:37:29
  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択のダイアログボックスじゃないから？
  '===================================================================
  'ＯＫボタンを押す
  Const WM_COMMAND = &H111
  Dim lngRc As Long
  lngRc = PostMessage(lngDHnd, WM_COMMAND, 1, 0)
  '===================================================================
• ReoReo72010/09/29 10:37:41
  ちなみに、その後に出てくる保存先する場所とファイル名も任意に変えて保存して、コントロールをIEに戻したいのですが、それも分かるならばお願いします。保存する場所は最悪デフォルトでも構いません。
• ReoReo72010/09/29 10:44:38
  もうちょっと言うと、formをsubmitしてもサーバーがビジーで失敗することもあるので、formのtargetの_blankをそのままにしておいて、新規ウィンドウでポップアップがあれば保存、新規ウィンドウで2秒待ってポップアップが無ければ新規ウィンドウを閉じてリトライ（再びformをsubmit）したいのですが、これは今の質問が解決したら別の質問でやろうかと考えています。。
• きゃづみぃ2010/09/29 11:12:55
  すみません、ちょっと 質問の意味を取り違えてました。
  
  http://officetanaka.net/excel/vba/statement/SendKeys.htm
  
  ダイアログのボタンを押す場合 DDEとかじゃないとほかは SendKeysしかないと思います。
  
• ReoReo72010/09/29 11:22:51
  DDEを調べてみましたが、よく分かりませんでした。DDEとは一言で言うと何でしょう？
  
  良く見るOK/キャンセルの2択のダイアログボックスでは、１つめのコメントのプログラムでOKが押せるみたいです。
  
  確かに、ポップアップが出てくるかどうかだけ待って、ポップアップを確認した時点で
  SenKeysで　[Alt]＋[S]　→　ファイル名をSenKeysで入力　→　SenKeysで　[Alt]＋[S]　→　ダウンロードが終わるまでの必要十分な時間waitしてから　SenKeysで　[Enter]
  としたほうが良いのかもしれませんね・・・。やっぱりそれしかないですかね？
• きゃづみぃ2010/09/29 11:31:51
  あ、今は DDEじゃなくて OLEなのかな。
  
  http://www.site-cooler.com/kwl/perl/ole.htm
  
  SenKeysの場合、実行中は ほかの操作ができないのが 難点なんですよねぇ。
  
  ま、それしかないといえば しょうがないですけど。
  
  
• ReoReo72010/09/29 22:27:18
  ありがとうございます！
  うーん、やっぱりSendkeysですか。一応仮に作り上げてみましたが、一応用を足しているようです。
  おかげさまで、動作が全然できないよりかかなり前進できました♪
• Silvanus2010/09/30 21:20:31
  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
• cx202010/10/07 06:37:28
  解決済みのようですが、参考まで。
  
  外部アプリを使用してもよいのであれば 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
  

質問の情報

登録日時

2010-09-29 10:29:15

終了日時

2010-10-05 15:28:03

回答条件

1人2回まで

この質問のカテゴリ

• コンピュータ
• ウェブ制作

この質問に含まれるキーワード

人気の質問

• 親族（実家）の犬が無駄吠えをしています。朝方に一時間くらい吠えているらしい。昼にも一時間くらい吠え続…匿名質問者1124時間前
• 東京都は山に四方を囲まれています。風水的にはどうですか？。匿名質問者11日前
• 誰か読んでくれませんか？ ゲームの話です アンダーテールっていうんですけど 話し相手が全然いないんです…yun_10241日前
• スマホ（アンドロイド）に、TypeAppを入れております。登録になっているメアドのいくつかを削除したいので…匿名質問者124時間前
• アスペルガー精神3級会社員男性(34歳独身)です。 元々眠りが浅いのに最近尚更深刻な夢や深く考え過ぎる夢を…hayakushinene21時間前

メニュー

• 質問一覧
• カテゴリ一覧
• 無料ユーザー登録
• 人力検索はてなトップ

PC版

• お問い合わせ
• ヘルプ
• お知らせ
• はてなトップ