如何通过VBA的InternetExplorer对象自动指定路径下载文件？

Hey there! Let's tackle this download popup problem you're facing with VBA and IE. SendKeys is notoriously unreliable for this kind of task—system focus, language settings, and timing issues can all break it. Here are a couple of robust solutions to auto-save the file to your preset directory without any user interaction:

Solution 1: Directly Download via API (Most Reliable) #

Instead of relying on IE and dealing with popups, we can bypass the browser entirely by simulating the form submission and saving the file directly using VBA. This is the best approach because it avoids all the fragility of UI automation.

Step 1: Add Helper Functions & API Declarations #

First, add these to your module to handle URL encoding and file saving:

' URL encode function to safely pass form data
Function URLEncode(ByVal strText As String) As String
    Dim strChar As String
    Dim intChar As Integer
    For intChar = 1 To Len(strText)
        strChar = Mid(strText, intChar, 1)
        Select Case strChar
            Case "A" To "Z", "a" To "z", "0" To "9", "-", "_", ".", "~"
                URLEncode = URLEncode & strChar
            Case Else
                URLEncode = URLEncode & "%" & Hex(Asc(strChar))
        End Select
    Next intChar
End Function

' For saving binary responses directly to file
Sub SaveBinaryData(ByVal strSavePath As String, ByVal arrBinaryData As Variant)
    Dim objStream As Object
    Set objStream = CreateObject("ADODB.Stream")
    With objStream
        .Open
        .Type = 1 ' Binary mode
        .Write arrBinaryData
        .SaveToFile strSavePath, 2 ' 2 = overwrite existing file
        .Close
    End With
    Set objStream = Nothing
End Sub

Step 2: Simulate Form Submission & Download #

Replace your existing IE code with this. It sends the same request as the download button, then saves the response to your preset path:

Sub AutoDownloadFile()
    Dim xmlHttp As Object
    Dim strFormData As String
    Dim strPresetPath As String
    Dim strTargetURL As String
    
    ' Set your preset save path (update this to your folder)
    strPresetPath = "C:\Your\Custom\Path\downloaded_file.xlsx"
    ' The URL your form submits to (check the form's action attribute in the page source)
    strTargetURL = "http://somewebsite.com/query.asp"
    
    ' Construct form data (match the names of your textarea and submit button)
    ' Replace "textareaName" with the actual name attribute of your textarea
    ' Replace "btnSubmit" with the name/value of your submit button
    strFormData = "textareaName=" & URLEncode(Sheets("UserEntry").Range("L37").Value) & _
                  "&btnSubmit=Submit"
    
    ' Create XMLHTTP object
    Set xmlHttp = CreateObject("MSXML2.XMLHTTP.6.0")
    
    ' Send POST request (use "GET" if your form uses GET instead of POST)
    xmlHttp.Open "POST", strTargetURL, False
    xmlHttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    xmlHttp.send strFormData
    
    ' Check if request succeeded
    If xmlHttp.Status = 200 Then
        ' Save the binary response to your preset path
        SaveBinaryData strPresetPath, xmlHttp.responseBody
        MsgBox "File saved successfully to: " & strPresetPath
    Else
        MsgBox "Request failed. Status code: " & xmlHttp.Status
    End If
    
    Set xmlHttp = Nothing
End Sub

Note: You'll need to check the actual name attributes of your textarea and submit button in the page source (use IE's developer tools) to match the form data correctly.

Solution 2: Automate the Download Popup (If You Must Use IE) #

If you can't bypass IE (e.g., the site requires session cookies or JS rendering), you can use Windows API calls to interact with the popups. This is less reliable due to system language/version differences, but it works if configured correctly.

Step 1: Add API Declarations #

Add these to your module:

Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
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
Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr

Private Const BM_CLICK = &HF5
Private Const WM_SETTEXT = &HC

Step 2: Modify Your Existing IE Code #

Update your original code to include the popup handling:

Sub IE_AutoDownload()
    Dim appIE As InternetExplorerMedium
    Dim strPresetPath As String
    Dim hDownloadDialog As LongPtr
    Dim hSaveBtn As LongPtr
    Dim hSaveAsDialog As LongPtr
    Dim hFileNameBox As LongPtr
    Dim StartTime As Double
    
    strPresetPath = "C:\Your\Custom\Path\downloaded_file.xlsx"
    StartTime = Timer
    Set appIE = New InternetExplorerMedium
    
    With appIE
        .Navigate "http://somewebsite.com/query.asp?"
        .Visible = True
        ' Wait for page to load
        Do While .Busy Or .ReadyState <> 4
            DoEvents
        Loop
        
        ' Fill textarea and click download button
        .Document.getElementsByTagName("textarea")(0).Value = Sheets("UserEntry").Range("L37")
        .Document.getElementsByName("btnSubmit")(203).Click
    End With
    
    ' Wait for "File Download" popup (adjust title for your system language)
    Do
        hDownloadDialog = FindWindow("#32770", "文件下载") ' Use "File Download" for English systems
        DoEvents
    Loop Until hDownloadDialog <> 0 Or Timer - StartTime > 10 ' Add timeout to avoid infinite loop
    
    ' Click "Save" button (adjust text for your system language)
    hSaveBtn = FindWindowEx(hDownloadDialog, 0, "Button", "保存(&S)") ' Use "Save" for English
    If hSaveBtn <> 0 Then SendMessage hSaveBtn, BM_CLICK, 0, 0
    
    ' Wait for "Save As" dialog
    Do
        hSaveAsDialog = FindWindow("#32770", "另存为") ' Use "Save As" for English systems
        DoEvents
    Loop Until hSaveAsDialog <> 0 Or Timer - StartTime > 20
    
    ' Enter preset path into filename box
    hFileNameBox = FindWindowEx(hSaveAsDialog, 0, "Edit", vbNullString)
    If hFileNameBox <> 0 Then
        SendMessage hFileNameBox, WM_SETTEXT, 0, ByVal strPresetPath
        ' Click final save button
        hSaveBtn = FindWindowEx(hSaveAsDialog, 0, "Button", "保存(&S)")
        If hSaveBtn <> 0 Then SendMessage hSaveBtn, BM_CLICK, 0, 0
    End If
    
    Set appIE = Nothing
    MsgBox "Download complete!"
End Sub

Important Notes:

• Adjust the dialog titles and button text to match your system's language (e.g., "File Download" instead of "文件下载" for English Windows).
• The timeout values prevent your macro from hanging if the popup doesn't appear as expected.

内容的提问来源于stack exchange，提问作者Shoaib Mohamed