如何在打开/保存/取消对话框中单击打开-IE和VBA

时间:2018-08-07 13:21:50

标签: excel excel-vba internet-explorer web-scraping access-vba

我正在尝试从公司网站下载报告以用于报告。

步骤:

  1. 打开IE
  2. 转到下载链接
  3. 单击提取按钮
  4. 单击IE对话框中的“打开”按钮(保存/打开/取消框)
  5. 将数据复制到我的有效工作簿的工作表
  6. 关闭IE

我已经完成了第3步。在第4步中遇到了麻烦。我尝试了以下解决方案,但它们对我没有用。

How to check if Open/Save/Cancel bar appeared

Automate saveas dialogue for IE9 (vba)

使用的代码:

Sub ExtractGLfile()

    Set ie = New InternetExplorerMedium
    Dim DLCPortalGL As String
    DLCPortalGL = "link"
    ie.Visible = True
    ie.navigate (DLCPortalGL)

    Do
        DoEvents
    Loop Until ie.readyState = READYSTATE_COMPLETE

    ie.document.getElementById("ButtonID").Click

我需要第4步的帮助-单击打开/保存/取消按钮的打开。

更新:我可以使用以下代码下载文件

    Application.SendKeys "%{O}", True
newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + 10
waitTime = TimeSerial(newHour, newMinute, newSecond)
Application.Wait waitTime

SendKeys "{TAB}", True
SendKeys "{ENTER}", True

但是,当文件打开时,出现错误:enter image description here 有什么建议吗?

1 个答案:

答案 0 :(得分:0)

如果您只是尝试下载页面或文件,则可以使用此快速功能 DownloadFile

Option Compare Database
Option Explicit

' API declarations.
'
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

' Download a file or a page with public access from the web. 
' Returns 0 if success, error code if not. 
' 
' If parameter NoOverwrite is True, no download will be attempted 
' if an existing local file exists, thus this will not be overwritten. 
' 
' Examples: 
' 
' Download a file: 
'   Url = "https://www.codeproject.com/script/Membership/ProfileImages/%7Ba82bcf77-ba9f-4ec3-bbb3-1d9ce15cae23%7D.jpg" 
'   FileName = "C:\Test\CodeProjectProfile.jpg" 
'   Result = DownloadFile(Url, FileName) 
' 
' Download a page: 
'   Url = "https://www.codeproject.com/Tips/1022704/Rounding-Values-Up-Down-By-Or-To-Significant-Figur?display=Print" 
'   FileName = "C:\Test\CodeProject1022704.html" 
'   Result = DownloadFile(Url, FileName) 
' 
' Error codes: 
' -2146697210   "file not found". 
' -2146697211   "domain not found". 
' -1            "local file could not be created." 
' 
' 2004-12-17. Gustav Brock, Cactus Data ApS, CPH. 
' 2017-05-25. Gustav Brock, Cactus Data ApS, CPH. Added check for local file. 
' 2017-06-05. Gustav Brock, Cactus Data ApS, CPH. Added option to no overwrite the local file. 
' 
Public Function DownloadFile( _ 
    ByVal Url As String, _ 
    ByVal LocalFileName As String, _ 
    Optional ByVal NoOverwrite As Boolean) _ 
    As Long 

    Const BindFDefault  As Long = 0 
    Const ErrorNone     As Long = 0 
    Const ErrorNotFound As Long = -1

    Dim Result  As Long

    If NoOverwrite = True Then 
        ' Page or file should not be overwritten. 
        ' Check that the local file exists. 
        If Dir(LocalFileName, vbNormal) <> "" Then 
            ' File exists. Don't proceed. 
            Exit Function 
        End If 
    End If     

    ' Download file or page. 
    ' Return success or error code. 
    Result = URLDownloadToFile(0, Url & vbNullChar, LocalFileName & vbNullChar, BindFDefault, 0)   

    If Result = ErrorNone Then 
        ' Page or file was retrieved. 
        ' Check that the local file exists. 
        If Dir(LocalFileName, vbNormal) = "" Then 
            Result = ErrorNotFound 
        End If 
    End If   

    DownloadFile = Result 

End Function

here可以找到完整的故事-以及有关是否进行缓存的信息。

相关问题