IEのダウンロード通知バーVBA制御

下記URLを参考にUIAutomationClientを利用して通知バーを制御していますが、通知バーはでているのにボタン取得に失敗しやすいです。
また、分割の名前を付けて保存
http://okwave.jp/qa/q8121989.html
基本的にSetの箇所にDo while　オブジェクト　is nothingを入れて確実に取得できるようにしました。しかし、そうすると取得までに時間がかかる場合があります。時間短縮の方法をアドバイス頂きたいのがこの度の趣旨になります。

具体的にはダウンロード時に名前を付けて保存をしたいのですが、例えば保存バーがでているのにドロップボタンを押すまで時間がかかる。また、ドロップボタンは押せているのに名前を付けて保存をなかなかすぐに押してくれないといった感じです。またその後の保存ダイアログでも同様に、表示されているのになかなか押してくれないといった状況です。
やはり、オブジェクトの取得がうまくできていないためWhileでぐるぐると取得するのに時間を費やしているようでした。どのようにすれば時間短縮ができるかアドバイス頂けると助かります。回答でなくても、これやってみたら？みたいな感じでアドバイス頂けると助かります。
宜しくおねがいします。

No.1 ベストアンサー 回答者： kumatti_1 回答日時： 2017/04/09 07:35

IE制御に於いてループ中のDoEventsは遅延を招くそうで、Sleepに置き換えるとか。

(ネットワークタブでキャプチャすれば)
後は、F12Chooser.exeを制御してダイアログや通知バーが表示されるタイミングで、ファイルへのアドレスが分かるので、
(UI Automation辺りで)

XMLHTTPとADODB.Streamの組み合わせでダウンロードするとか、ぐらいですかね。

この回答へのお礼

ご返信遅れまして大変失礼いたしました。
只今新しい質問をしようと久しぶりに開いたら返信をし忘れておりました。
WindFallerさんにもご回答頂いていたようで、もしかしたらそちらも効果があるのかもしれませんが、kumatti_1さんのご意見を採用させて頂きました。
結果は、失敗率が激減致しました。
本当にありがとうございました。

新しい質問は、タイトル以下のとおりです。お時間有りましたらよろしくお願いいたします。
VBA：ホームページ内のデータテーブルスクロールバーの操作

お礼日時：2017/06/10 03:07

No.3 回答者： WindFaller 回答日時： 2017/04/12 00:30

この前から、私が開発していたものを見ていただけますか？#1さんのおっしゃっていたものは、一度でダウンロード先が取れるものならよいのですが、Vector のように、サイト内で二回ダウンロード先を探しているのです。

なかなか手間が掛かります。以下は、うまくいかない時は、ひとつは、URLを確かめてください。後は、IEキャッシュの問題があるかもしれません。

'//
Private Declare Function URLDownloadToFile Lib "urlmon" Alias _
"URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal _
szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
Private Declare Function DeleteUrlCacheEntry Lib "wininet" Alias "DeleteUrlCacheEntryW" ( _
ByVal lpszUrlName As Long) As Long

Sub Vector_DownLoadMacro()
　Dim VectorURL As String
''==================
''ソフト名：Getswf
''仕様：IEやOperaのキャッシュファイル(FLASH、画像、動画等)を簡単に仕分け・保存
VectorURL = "http://www.vector.co.jp/soft/winnt/net/se404798. …
''=================
　'URLを修正
　If InStr(1, VectorURL, "/dl") = 0 Then
　　VectorURL = Replace(VectorURL, "/soft/", "/soft/dl/", , 1, 1)
　End If
　Dim Access_Location As String
　Dim objIE As SHDocVw.InternetExplorer　'
　Set objIE = CreateObject("InternetExplorer.Application")
　Dim objShellWin As Object　''As Microsoft Shell Controls And Automation
　Dim flg As Boolean
　Dim w As Object
　
　Const baseKeyWord As String = "www.vector.co.jp/soft/dl"

　Set objShellWin = CreateObject("Shell.Application").Windows()
　If objShellWin.Count = 0 Then Exit Sub
　For Each w In objShellWin
　　If TypeName(w) = "IWebBrowser2" Then
　　　If InStr(1, w.LocationURL, baseKeyWord, 1) > 0 Then
　　　　Set objIE = w
　　　　flg = True
　　　　Exit For
　　　End If
　　End If
　Next
　
　Dim newURL As String
　Dim DLoadURL As String
　Dim DLName As String
　Dim btn As Object
　objIE.Navigate2 VectorURL
　objIE.Visible = True
　Do While objIE.Busy Or objIE.readyState <> 4: DoEvents: Loop
　With objIE
　　Set btn = .document.getElementsByClassName("btn download")
　　If btn.Length = 0 Then MsgBox "失敗しました。", vbExclamation: Exit Sub
　　newURL = btn(0).href
　　.Navigate2 newURL
　Do While objIE.Busy Or objIE.readyState <> 4: DoEvents: Loop
　End With
　With objIE
　Dim oData As Object
　Dim oData_c As Object
　Dim i As Long
　Dim downURL As String
　Dim buf
　　Set oData = .document.getElementById("summary")
　　Set oData_c = oData.ChildNodes
　　For i = 1 To oData_c.Length - 1
　　　'On Error Resume Next
　　　If TypeName(oData_c(i)) = "HTMLParaElement" Then
　　　If InStr(1, oData_c(i).innerHTML, "ftp", vbTextCompare) > 0 Then
　　　　　buf = oData_c(i).innerHTML
　　　　　If buf <> "" Then
　　　　　DoEvents
　　　　　　 Exit For
　　　　　End If
　　　 End If
　　　End If
　　　'On Error GoTo 0
　　Next
　　buf = Mid(buf, InStr(1, buf, "http:"))
　　downURL = Mid(buf, 1, InStr(1, buf, ">") - 2)
　　Call URLDownloads(downURL)
　　.Quit
　End With
　Set objIE = Nothing
End Sub
Sub URLDownloads(ByVal strURL As String)
　Const myDOWNDIR As String = "C:\Users\Wendy\Downloads\"
　Dim strFName As String
　Dim lastURL As String
　Dim i As Long
　Dim returnValue

　i = InStrRev(strURL, "/")
　lastURL = Mid(strURL, i + 1)
　strFName = myDOWNDIR & lastURL
dwnStart:
　'URLDownloadToFile API をコールする
　DeleteUrlCacheEntry StrPtr(strURL)
　returnValue = URLDownloadToFile(0, strURL, strFName, 0, 0)
　If Dir(strFName) <> "" Then
　　MsgBox lastURL & ": Download Success"
　Else
　　MsgBox "Failure!", vbCritical
　End If
End Sub

''参考：　https://www.ka-net.org/blog/?p=4855

No.2 回答者： WindFaller 回答日時： 2017/04/09 13:08

こんにちは。

最初に、#1さんの書かれた内容は、こちらも是非見当してみたいと思いました。
「ファイルへのアドレスが分かる」ということが、実際ネックなのです。

実は、ひろんろんらん・さんの質問が出てから、最初に回答を差し上げた後、こちらも、ずっとその開発に関して自分なりに工夫や考えてみました。UIAutomationClientは知ってはいたけれども、「(ダウンロード）ファイルへのアドレスが分か」らないから、物理的？なクリック式になってしまうのではないでしょうか。(失礼な言い方に聞こえたらすみませんです）

前の話をきっかけに、こちらも体制を整えて、今、画像やら、動画やらプロテクトがかかっていないダウンロードできるものなら、ありとあらゆるものを試してみました。最近では、RTMPまで試してみましたが、それらはほとんど成功しています。

>オブジェクトの取得がうまくできていないため
正確に言えば、オブジェクトのURLだと思います。

それを、IE等のブラウザでアクセスしていたら、二重手間になってしまうので、WinHttp.WinHttpRequest　で、ファイル名を探して、Win APIの　URLDownloadToFile でダウンロードするようにしました。たぶん、こういうことは経験者は多くおられるとは思いますが、私自身はまったくの未経験でしたし、何も知らないままに暗中模索で行っていますが、とても興味があります。

P Capture などは、実際の運用では使わないでしょうけれども、ファイルの保存先から、新たなURLを想定することは可能になるのだと思っています。

もちろん、それは許される条件下がないと出来ませんが、ファイルのURLさえ分かれば、ほとんどは可能にするはずです。ちょっと話がずれているかもしれませんが。

この回答へのお礼

ご返信遅れまして大変失礼いたしました。
只今新しい質問をしようと久しぶりに開いたら沢山の内容が記載されており驚いております。
まだきちんと眺めていないので別途確認をさせて下さい。
なお本件kumatti_1さんのご意見を採用し効果を確認できました。

本当にありがとうございました。

ちなみに、、新しい質問は、タイトル以下のとおりです。お時間有りましたらよろしくお願いいたします。
VBA：ホームページ内のデータテーブルスクロールバーの操作

お礼日時：2017/06/10 03:09