VBA - 转到网站并从保存提示下载文件

使用VBA编程可以实现许多自动化任务，其中之一是通过VBA代码自动访问网站并下载文件。本文将介绍如何使用VBA代码实现这个功能，并提供一个案例代码来演示。

vba
Dim browser As Object
Set browser = CreateObject("InternetExplorer.Application")
browser.Visible = True
browser.Navigate "https://www.google.com"

vba
Dim links As Object
Set links = browser.Document.getElementsByTagName("a")
For Each link In links
    If link.innerText = "Gmail" Then
        link.Click
        Exit For
    End If
Next link

vba
Dim downloadFolder As String
downloadFolder = "C:\Downloads\"
Dim downloadLink As Object
Set downloadLink = browser.Document.getElementById("downloadLink")
Dim downloadURL As String
downloadURL = downloadLink.href
Dim fileName As String
fileName = "example.pdf"
Dim savePath As String
savePath = downloadFolder & fileName
Dim http As Object
Set http = CreateObject("MSXML2.XMLHTTP")
http.Open "GET", downloadURL, False
http.send
Dim stream As Object
Set stream = CreateObject("ADODB.Stream")
stream.Open
stream.Type = 1 'binary
stream.Write http.responseBody
stream.SaveToFile savePath, 2 'overwrite existing file
stream.Close

vba
Sub DownloadFile()
    Dim browser As Object
    Set browser = CreateObject("InternetExplorer.Application")
    browser.Visible = True
    browser.Navigate "https://www.google.com"
    
    '等待网页加载完成
    Do While browser.Busy
        DoEvents
    Loop
    
    Dim links As Object
    Set links = browser.Document.getElementsByTagName("a")
    
    For Each link In links
        If link.innerText = "Gmail" Then
            link.Click
            Exit For
        End If
    Next link
    
    '等待文件下载完成
    Do While browser.Busy
        DoEvents
    Loop
    
    Dim downloadFolder As String
    downloadFolder = "C:\Downloads\"
    
    Dim downloadLink As Object
    Set downloadLink = browser.Document.getElementById("downloadLink")
    
    Dim downloadURL As String
    downloadURL = downloadLink.href
    
    Dim fileName As String
    fileName = "example.pdf"
    
    Dim savePath As String
    savePath = downloadFolder & fileName
    
    Dim http As Object
    Set http = CreateObject("MSXML2.XMLHTTP")
    http.Open "GET", downloadURL, False
    http.send
    
    Dim stream As Object
    Set stream = CreateObject("ADODB.Stream")
    stream.Open
    stream.Type = 1 'binary
    stream.Write http.responseBody
    stream.SaveToFile savePath, 2 'overwrite existing file
    stream.Close
    
    MsgBox "文件已下载到：" & savePath
End Sub