web-dev-qa-db-ja.com

VBAでIE11の[開く/保存しますか]ダイアログウィンドウボタンを制御する

NASDAQWebサイトからファイルを自動的にダウンロードする必要があります。私の既存のVBAコードはIE "Do you want to Open/Save"ダイアログウィンドウを開いています。その保存ボタンをクリックしてVBA経由でパスを指定する方法は？さまざまなWindowsAPIメソッドを試しましたこのリンクで説明されています ここ また、「ウィンドウが見つかりません」という結果が表示されます。

私の現在のコードは以下の通りです：

Sub MyIEauto()

    Dim ieApp As InternetExplorer
    Dim ieDoc As Object
    'Dim ieTable As Object

    'create a new instance of ie
    Set ieApp = New InternetExplorer

    'you don’t need this, but it’s good for debugging
    ieApp.Visible = True
    'assume we’re not logged in and just go directly to the login page
    ieApp.Navigate "https://indexes.nasdaqomx.com/Account/LogOn"
    Do While ieApp.Busy: DoEvents: Loop
    Do Until ieApp.readyState = READYSTATE_COMPLETE: DoEvents: Loop

    Set ieDoc = ieApp.Document
    'fill in the login form – View Source from your browser to get the control names
    With ieDoc.forms(0)
        .UserName.Value = "xxxxxxx"
        .Password.Value = "xxxxxxx"
        .submit
    End With
    Do While ieApp.Busy: DoEvents: Loop
    Do Until ieApp.readyState = READYSTATE_COMPLETE: DoEvents: Loop

    'now that we’re in, go to the page we want
    ieApp.Navigate "https://indexes.nasdaqomx.com/Index/ExportWeightings/NDX?tradeDate=2015-08-19T00:00:00.000&timeOfDay=SOD/SODWeightings_2015"

    'next below line commented as it is failing
    'ieApp.ExecWB 4, 2, "D:\VBA code work\SODWeightings_20150819_NDX.xlsx" 

    set ieApp=Nothing
    set ieDoc=Nothing

End Sub

以下のスクリーンショットは、私が到達した場所を示しています。ここからどのように進めますか？

enter image description here

vbaexcel-vbainternet-explorerexcel
4
pmr

これを行う別の方法は、ショートカットキーのキーストロークを送信してIE11の保存ボタンをクリックすることです。これを機能させるには、IEウィンドウがアクティブウィンドウである必要があることに注意してください。したがって、デバッグモードでは機能しません。

以下のコードはショートカットキーを呼び出します。ショートカットキーを表示しているだけなので、何が起こっているのかがわかります。

  • ショートカットキー：Alt+S
  • VBA：Application.SendKeys "%{S}"
3
Tony L.

ついに解決しました...

Option Explicit

Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
(ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Long

Public Sub AddReference()

    ThisWorkbook.VBProject.References.AddFromFile "C:\Windows\SysWOW64\UIAutomationCore.dll"

End Sub

'after my original code as posted in question then this below lines

Dim o As IUIAutomation
    Dim e As IUIAutomationElement
    Set o = New CUIAutomation
    Dim h As Long
    h = ieApp.hWnd
    h = FindWindowEx(h, 0, "Frame Notification Bar", vbNullString)
    If h = 0 Then Exit Sub

    Set e = o.ElementFromHandle(ByVal h)
    Dim iCnd As IUIAutomationCondition
    Set iCnd = o.CreatePropertyCondition(UIA_NamePropertyId, "Save")

    Dim Button As IUIAutomationElement
    Set Button = e.FindFirst(TreeScope_Subtree, iCnd)
    Dim InvokePattern As IUIAutomationInvokePattern
    Set InvokePattern = Button.GetCurrentPattern(UIA_InvokePatternId)
    InvokePattern.Invoke
11
pmr

64ビット環境のieApp.hWndはLongLongであり、hはLongであるため、これにより型の不一致が発生し、次の方法で簡単に解決できます。

h = Clng(ieApp.hWnd)
2
Johan de Wispelaere

SendKeysは私にとっての解決策でした。

myfile = "C:\Users\User\Downloads\myfile.xls" 
checkmyfile = Dir(myfile, vbArchive)

Do While checkmyfile = ""
    On Error Resume Next
    checkmyfile = Dir(myfile , vbArchive)
    If checkmyfile = "myfile.xls" Then Exit Do 
    AppActivate "Title - Internet Explorer"
    SendKeys "%(g)"
    Application.Wait Now + TimeValue("0:0:1")
Loop
0
Flash