4

在过去的几个小时里，我一直在试图弄清楚如何使用 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

4

2 回答 2

1

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

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

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

  • 因此，请尝试通过在浏览器中输入来确保您使用的 url 正确无误。如果它打开正确的 .csv 文件，那么您的源代码也可以工作。
  • 还请尝试发送更多信息：例如 .csv 文件的 url
于 2016-01-10T22:16:01.830 回答
0

试试下面的代码：

从这里复制（未测试）

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
于 2013-05-23T02:57:09.820 回答