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

Posted 2023-02-18

【中文标题】VBA - 转到网站并从保存提示下载文件

【英文标题】：VBA - Go to website and download file from save prompt

【发布时间】：2013-05-18 05:50:41

【问题描述】：

过去几个小时我一直在试图弄清楚如何使用 VBA 将文件保存到计算机上。我在另一个论坛上找到的下面的代码模板看起来很有希望，除非我去桌面访问它，.csv 文件看起来像页面的源代码，而不是我想要的实际文件。这可能是因为当我转到 URL 时，它不会自动下载文件；相反，我被要求将文件保存到某个位置（因为我不知道网站上上传文件的路径名）。 有什么办法可以更改此代码以适应这种情况，还是我必须完全使用不同的代码？

Sub Test()
Dim FileNum As Long
Dim FileData() As Byte
Dim MyFile As String
Dim WHTTP As Object

On Error Resume Next
    Set WHTTP = CreateObject("WinHTTP.WinHTTPrequest.5")
    If Err.Number <> 0 Then
        Set WHTTP = CreateObject("WinHTTP.WinHTTPrequest.5.1")
    End If
On Error GoTo 0


MyFile = "MY_URL_HERE"

WHTTP.Open "GET", MyFile, False
WHTTP.send
FileData = WHTTP.responseBody
Set WHTTP = Nothing

If Dir("C:\Users\BLAHBLAH\Desktop", vbDirectory) = Empty Then MkDir "C:\Users\BLAHBLAH\Desktop"

FileNum = FreeFile
Open "C:\Users\BLAHBLAH\Desktop\memberdatabase.csv" For Binary Access Write As #FileNum
    Put #FileNum, 1, FileData
Close #FileNum

End Sub

跨帖：http://www.ozgrid.com/forum/showthread.php?t=178884http://www.excelforum.com/excel-programming-vba-macros/925352-vba-go-to-website-and-download-file-from-save-prompt.html

【参考方案1】：

多年来，我发现了更多如何使用 vba save/download data：

我更喜欢并推荐的第一个选项是使用user32 library 的URLDownloadToFile function 使用以下solution 第二个也被提到是你自己。这里的重点是使用Microsoft WinHTTP Services (Interop.WinHttp) COM library。为了实现这一点，您还可以将 Interop.WinHttp 引用添加到您的项目link。之后，您可以使用更简单的符号，例如link 我知道的第三个选项是让浏览器为我们保存它，然后使用 Santosh 提到的Save_Over_Existing_Click_Yes 函数。在这种情况下，我们使用 COM 接口打开 Internet Explorer 并导航到正确的站点。所以我们必须将Microsoft Internet Controls (Interop.SHDocVw) 和Microsoft HTML Object Library (Microsoft.mshtml) 引用添加到我们的项目中，以获得编辑器的智能感知功能。 我不喜欢这种下载方法，因为这是通过黑客手段解决的问题。但是，如果您的 IE 会话已经建立，经过身份验证等，这会很好地工作。出于安全考虑，删除了 Internet 控件的保存功能。例如：link

更新越少，您必须拥有正确的网址来下载您想要的内容。如果你选错了，你会下载别的东西:)

所以请尝试通过在浏览器中输入来确保您使用的 url 是正确的。如果它打开正确的 .csv 文件，那么您的源代码也可以工作。 还请尝试发送更多信息：例如 .csv 文件的 url

【参考方案2】：

试试下面的代码：

复制自here（未测试）

Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long

Declare Function SetForegroundWindow Lib "user32" Alias "SetForegroundWindow" (ByVal hwnd As Long) As Long

Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Declare Sub Sleep Lib "kernel32" Alias "Sleep" (ByVal dwMilliseconds As Long)

    Private Sub Save_Over_Existing_Click_Yes()

        Dim hWnd As Long
        Dim timeout As Date

        Debug.Print "Save_Over_Existing_Click_Yes"

        'Find the Download complete window, waiting a maximum of 30 seconds for it to appear.  Timeout value is dependent on the
        'size of the download, so make it longer for bigger files

        timeout = Now + TimeValue("00:00:30")
        Do
            hWnd = FindWindow(vbNullString, "Save As")
            DoEvents
            Sleep 200
        Loop Until hWnd Or Now > timeout
        Debug.Print "   Save As window "; Hex(hWnd)

        If hWnd Then
            'Find the child Close button

            hWnd = FindWindowEx(hWnd, 0, "Button", "&Yes")
            Debug.Print "   Yes button "; Hex(hWnd)
        End If

        If hWnd Then

            'Click the Close button

            SetForegroundWindow (hWnd)
            Sleep 600  'this sleep is required and 600 miiliseconds seems to be the minimum that works
            SendMessage hWnd, BM_CLICK, 0, 0
        End If
    End Sub

【讨论】：

谢谢，Santosh，但是我可以在代码中的什么位置插入我的网址？我希望代码自动转到网址，而不是我必须手动转到那里。

@user2370064 您需要在获得文件下载对话框后调用此函数

好吧，我添加了可以导航到网站的代码，但我得到：编译错误：常量、固定长度字符串、用户定义类型和声明语句不允许作为对象模块的公共成员.我将如何解决这个问题？抱歉，我几乎是 VBA 的初学者。

@user2370064 你能把整个代码放在你的帖子里吗？否则您是否可以共享工作簿。

我只是将这些代码行放在“Private Sub Save_Over_Existing_Click_Yes()”和“Dim hWnd As Long”之间： Dim IE As New InternetExplorer IE.Visible = True IE.navigate "gainnet.org/main/membership/downloadMemberData?type=" Just所以您知道，您将无法访问该网站，因为它受密码保护。