从互联网下载文件的VBA代码有时只能工作吗?

时间:2017-04-25 15:26:52

标签: vba

首先,this is the sort of website我正在尝试下载文件(通过点击"下载数据"启用CSV选项)。有问题的代码(我认为;它很难说,部分原因是它只在全速运行代码时出现,而不是单步执行,部分原因是问题不一致,部分原因在于它不会一直发生),是这样的:

Option Explicit 'this stuff at the beginning, of course

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

Sub ContactWeb(ByVal URL As String)

Dim IE As InternetExplorer
'leaving these here so you can see what it is I'm working with right now
Dim Doc As Object, Elmt As Object
Dim HTMLColl As MSHTML.IHTMLElementCollection

Dim Handle As LongPtr
Dim CUI As IUIAutomation
Dim HandleElement As IUIAutomationElement
Dim Condition As IUIAutomationCondition
Dim Button As IUIAutomationElement
Dim InvokePattern As IUIAutomationInvokePattern

Set IE = New InternetExplorer

With IE
    'code that loops through elements/clicks on csv and download data goes here

    Set CUI = New CUIAutomation
    'this point on just clicks "save" on the "do you want to open or save" bar

SetHandle:
    Do
        Handle = FindWindowEx(.Hwnd, 0, "Frame Notification Bar", vbNullString)
    Loop While Handle = 0

    If Handle = 0 Then  'just in case it somehow breaks out of that loop
        .Visible = True
        MsgBox "Could not download file; please do so manually."
        Stop
        GoTo SetHandle 'I really really *really* hate GoTo
            'but I wasn't sure how to eliminate it in this case
    End If

    'this is the spot I think where it starts failing sometimes
    'or at least, the above seems to work a lot more consistently

        DoEvents    'if you try to go through this full tilt
            'it will return "object variable or with block variable not set"
            'so this slows it down a bit
    Set HandleElement = CUI.ElementFromHandle(ByVal Handle)
        DoEvents
    Set Condition = CUI.CreatePropertyCondition(UIA_NamePropertyId, "Save")
        DoEvents
    Set Button = HandleElement.FindFirst(TreeScope_Subtree, Condition)
        'this is the only part that actually requires IE to be visible
            '(for reasons unknown to me)
        DoEvents
    Set InvokePattern = Button.GetCurrentPattern(UIA_InvokePatternId)
        DoEvents
    InvokePattern.Invoke

    .Quit

End With

End Sub

如上所述,此代码始终运行,但文件并不总是出现...如果我自动运行它。当我一步一步地运行它时,它总是像魅力一样(除了有一次它被卡在一个永恒的循环中 - 我有一个评论想知道完整或交互是否更有意义)。有人可以帮帮我吗?为什么会这样?

0 个答案:

没有答案