Question

我花了最后几个小时试图弄清楚如何使用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=178884
http://www.excelforum.com/excel-programming-vba-macros/925352-vba-go-to-website-and-download-file-from-save-prompt.html

Answer 1

多年来我发现了save/download data使用vba的更多方法：

我更喜欢并建议的第一个选项是使用以下solution

URLDownloadToFile function

第二个也被提及的是你自己。这里的要点是使用user32 library。为了实现此目的，您还可以将Interop.WinHttp引用添加到项目link。之后，您可以使用更简单的表示法，例如link
我知道的第三个选项是要求浏览器为我们保存，然后使用Santosh提到的Microsoft WinHTTP Services (Interop.WinHttp) COM library功能。在这种情况下，我们使用COM界面打开Internet Explorer并导航到正确的站点。因此，我们必须将Save_Over_Existing_Click_Yes（Microsoft Internet Controls）和Interop.SHDocVw（Microsoft HTML Object Library）引用添加到项目中，以获得编辑器的智能感知功能。我不喜欢这个下载方法，因为这是一个黑客的解决方法。但如果你的IE会话已经建立了认证等，这将很好地工作。由于安全问题，Internet控件的保存功能被删除。例如，请参阅：link

越新越少，你必须有正确的网址来下载你想要的东西。如果您选错了，您将下载其他内容：）

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

Answer 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

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

2 个答案: