VBA下载文件 使用WebBrowser 及 DoFileDownload

一、启动WebBrowser

在Excel打开时启动：先激活WebBrowser所在的表，继而在表激活事件中激活WebBrowser，在WebBrowser定位到网页。

1：在workbook启动时激活该webbrowser所在的worksheet

Private Sub Workbook_Open()

    ThisWorkbook.Worksheets("web").Activate

End Sub

 

2：在worksheet被激活时，设置webbrowser的页面导航

Private Sub Worksheet_Activate()

    WebBrowser1.Activate

    WebBrowser1.Navigate "https://...."

End Sub

也可以通过按钮激活，略过。

 

二、使用 DoFileDownload

1. 调用API前的声明

Private Declare PtrSafe 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

参数解释：

pCaller：如果调用的应用不是一个ActiveX组件，则可以设为Null

szURL：要下载的URL

szFileName：存储的文件名

dwReserved：必须为NULL

lpfnCB：与下载进度相关的东西

 

2. 创建一个调用API的功能函数，这里主要是用于后面判断是否下载文件成功

Public Function downloadFile(ByVal strURL As String, ByVal strFile As String) As Boolean

Application.EnableCancelKey = xlDisabled

Dim lngReturn&

'用lngReturn接收返回的结果

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

' 注意：URLDownloadToFile函数返回0表示文件下载成功

'判断返回的结果是否为0,则返回True，否则返回False

If lngReturn = 0 Then

    downloadFile = True

Else

    downloadFile = False

End If

End Function

 

3. 创建下载的执行功能

Private Function DL_rpt(ByVal Down_link As String)

    dim FileName$

    FileName = "abc.tsv"

    If downloadFile(Down_link , FileName) = True Then

        msgbox "Download Successfully"

    Else

        msgbox "Download Failed"

    End If

End Sub

PS：

1. URLDownloadToFile 默认文件下载到当前excel工作簿的所在路径
2. 如果有重复的文件名存在，则会直接覆盖

三、使用WebBrowser进入某个网页，然后调用DL_rpt功能

（因为下载的文件链接可能是要进入某个页面才能使用或看得到）

Sub Into_HomePage()

    On Error GoTo Err_Handle     '出错就去Err_Handle

    Call wait_for_reaction    '调用一个自定义等待网页响应的function

    If WebBrowser1.Document.ReadyState = "complete" Then

        WebBrowser1.Document.getElementById("searchAccount.searchString").innerText = 105030  '1

        WebBrowser1.Document.all("go-btn").Click    '2

        a = WebBrowser1.Document.getElementById("row").Children.tags("tbody")(0).Children.tags("tr")(1) _
            .Children.tags("td")(0).Children.tags("a")(0).innerText   '3

        WebBrowser1.Document.getElementById("row").Children.tags("tbody")(0).Children.tags("tr")(1) _
            .Children.tags("td")(0).Children.tags("a")(0).Click   '3

        '上面两步是等待页面响应完成后，使用WebBrowser对网页进行操作：

        1. 找到id为"searchAccount.searchString"的元素，填入105030

        2. 对id为"go-btn"的元素进行点击操作

        3. 获取某个id为"row"，在这个id下面某个a标签的文本，然后a标签进行点击的操作，要理解Children.tags("tbody")(0).Children.tags("tr")(1)的意思

        Call wait_for_reaction

        Call msg_for_reaction_completed   '只是为了看网页响应是否完成，可以省略

        dim dl_URL$

        dl_URL = "https://......."

        Call DL_File(dl_URL)

    End If

    Exit Sub

Err_Handle:

        Application.OnTime Now + TimeValue("0:0:5"), "Into_HomePage"    '等待5秒，重新启动Into_HomePage这个过程

End Sub

Sub wait_for_reaction()

    '设置5秒的等待时间，不断循环，直到网页响应完成，这DoEvent代表前面的VBA程序继续运行
    Do While WebBrowser1.Document.ReadyState <> "complete" Or WebBrowser1.ReadyState <> READYSTATE_COMPLETE
        t = Timer
        While Timer < t + 5
            DoEvents
        Wend
    Loop
End Sub

Sub msg_for_reaction_completed()
    If WebBrowser1.Document.ReadyState = "complete" Then
        MsgBox "WebPage Loaded Finished !"
    End If
End Sub

 

四、webbrowser另一个文件下载功能：DoFileDownload 另存为

声明API调用

Private Declare PtrSafe Function DoFileDownload Lib "shdocvw.dll" (ByVal lpszFile As String) As Long

过程中调用

dim Download_Url as String

dim Save_File as String

Download_Url = "Https://......"

Save_File = StrConv(Download_Url, vbUnicode)

Call DoFileDownload(Save_File)

PS：会有弹窗确定是否下载，暂时未找到解决办法

 

有其他问题再继续完善....