通过VBA进行IE自动化可按预期执行，但会引发自动化错误

Question

我有以下代码，应该打开Internet Explorer才能下载文件。

Sub hentRapport()
  Dim IEapp As Object
  Dim WebUrl As String

  Set IEapp = CreateObject("InternetExplorer.Application") 'Set IEapp = InternetExplorer
  WebUrl = Oversikt.Range("Adresse")

  With IEapp
    .Silent = True 'No Pop-ups
    .Visible = True 'Set InternetExplorer to Visible
    .Navigate WebUrl 'Load web page

    'Run and Wait, if you intend on passing variables at a later stage
    Do While .Busy
        DoEvents
    Loop

    Do While .ReadyState <> 4
        DoEvents
    Loop
  End With
End Sub

Internet Explorer（IE 11.0.9600.17691）会按预期方式打开，并且出现下载文件的对话框 ，但与此同时，我从宏中收到错误消息：

错误发生在线

Do While .ReadyState <> 4

我不知道为什么。 那行不是简单地指出Excel在接受其他输入之前不需要等待IE完成其工作吗？

---

找到了解决方案

经过大量的搜索之后，我终于看到了此页面 ，其中包含一个解决方案：

该问题与IE8和保护模式：打开功能有关。 这样做的目的是防止运行恶意软件，但同时也阻止合法的VBA代码运行。 根据您的工作环境，禁用此选项可能不是一种选择。 更不用说与此相关的一般风险。

我建议以下解决方案。

而不是使用：

Set ie = CreateObject("InternetExplorer.Application&qu ot;)

采用：

Set ie = New InternetExplorerMedium

您将需要添加对Microsoft Internet控件的引用。

现在我只希望所有用户都拥有该库：D

Answer 1

更快的东西怎么样？ 使用我认为IE正在使用的API函数来下载文件。

Option Explicit

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


Public Function DownFromWeb(strURL As String, strFile As String) As Boolean
    Dim ret As Long

    ret = URLDownloadToFile(0, strURL, strFile, 0, 0)

    If ret Then
        MsgBox "Failed to download file", vbExclamation
    End If

    DownFromWeb = (ret = 0)
End Function

Public Sub TestDownload()
    Const URL As String = _
        "https://www.gravatar.com/avatar/eab3ce1e413f1043da3a1574a0ab7360?s=24&d=identicon&r=PG&f=1"

    Dim sDstFolder As String
    Dim sFullPathFileName As String

    ' get the destination of the temp folder.
    ' it should give you the path like you do in windows:
    ' Start-> Run-> %temp%
    sDstFolder = Environ("temp")

    ' add a "\" at the end of the destination path as needed
    sDstFolder = sDstFolder & IIf(Right(sDstFolder, 1) = "\", "", "\")

    ' combine the path with a file name to your choosing
    sFullPathFileName = sDstFolder & "360.png"

    ' This will try to delete the previously downloaded file( just in case)
    On Error Resume Next
    Kill sFullPathFileName
    On Error GoTo 0

    If (DownFromWeb(URL, sFullPathFileName) = True) Then
          ' Open the file (probably a windows popup will appear):
          Shell "explorer " & sFullPathFileName
          ' OR
          ' if it is an excel file, you could do:
          ' Workbooks.Open(sFullPathFileName).Activate
    End If
End Sub

！ 顺便说一句，如果您只需要下载并打开excel文件 ，Office就会有一个内置选项（也可以使用doc文件）。 在这种情况下，您可能会像这样用一根内胆“逃脱”：

Workbooks.Open("http://highlycited.com/highly_cited_2001.xlsx").Activate

Answer 2

Excel无法识别指定的状态。 如果您更改了预期收益，则应该可以正常运行。

While .document.ReadyState <> "complete"
  'loop
Wend

在这里查看更多