VBA - 转到网站并从保存提示下载文件
声明:本页面是StackOverFlow热门问题的中英对照翻译,遵循CC BY-SA 4.0协议,如果您需要使用它,必须同样遵循CC BY-SA许可,注明原文地址和作者信息,同时你必须将它归于原作者(不是我):StackOverFlow
原文地址: http://stackoverflow.com/questions/16704281/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
VBA - Go to website and download file from save prompt
提问by user2370064
I've been spending the last few hours trying to figure out how to save a file onto the computer using VBA. The code template below that I found on another forum seems promising, except when I go to the desktop to access it, the .csv file has what looks like the page's source code instead of the actual file I want. This may be because when I go to the URL, it doesn't automatically download the file; rather, I am asked to save the file to a certain location (since I don't know the path name of the uploaded file on the site). Is there any way to alter this code to accommodate this, or will I have to use a different code entirely?
在过去的几个小时里,我一直在试图弄清楚如何使用 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
Cross posts:
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
交叉帖子:
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
回答by SchLx
I found over the years more ways how to save/download data
using vba:
多年来,我发现了更多save/download data
使用 vba 的方法:
- The firs option witch I prefer and would recommend is to use the
URLDownloadToFile function
of theuser32 library
using the following solution - The second one which was also mentioned be yourself. The point here is to use the
Microsoft WinHTTP Services (Interop.WinHttp) COM library
. In order to achieve this you can also add the Interop.WinHttp reference to your project link. After that you are able to use simpler notation like here link - The third option I aware is to ask the browser to save it for us and then using the
Save_Over_Existing_Click_Yes
function was mentioned by Santosh. In this case we open an Internet Explorer using the COM interface and navigate to the proper site. So we have to add theMicrosoft Internet Controls
(Interop.SHDocVw
) and theMicrosoft HTML Object Library
(Microsoft.mshtml
) references to our project in order to gain intellisense feature of the editor. I don't like this download methodbecause this is a work around by hacking. BUT if your IE session was already established authenticated etc. this gonna work nicely. The save function of the Internet Controls was dropped because of security concern. See for example: link
- 杉杉选项巫婆我喜欢和建议是使用
URLDownloadToFile function
的的user32 library
使用下面的解决方案 - 也提到的第二个是你自己。这里的重点是使用
Microsoft WinHTTP Services (Interop.WinHttp) COM library
. 为了实现这一点,您还可以将 Interop.WinHttp 引用添加到您的项目链接。之后,您可以使用更简单的符号,如此处链接 - 我知道的第三个选项是让浏览器为我们保存它,然后使用
Save_Over_Existing_Click_Yes
Santosh 提到的功能。在这种情况下,我们使用 COM 接口打开 Internet Explorer 并导航到正确的站点。因此,我们必须将Microsoft Internet Controls
(Interop.SHDocVw
) 和Microsoft HTML Object Library
(Microsoft.mshtml
) 引用添加到我们的项目中,以获得编辑器的智能感知功能。我不喜欢这种下载方法,因为这是一种通过黑客攻击的变通方法。但是,如果您的 IE 会话已经通过身份验证等建立,这会很好地工作。出于安全考虑,Internet Controls 的保存功能已被删除。参见例如:链接
Newer the less you have to have the correct url to download what you want. If you pick the wrong one you will download something else :)
更新越少,您必须拥有正确的 url 来下载您想要的内容。如果你选错了,你会下载别的东西:)
- So please try to make sure the the url you use is correct by enter it in a browser. If it opens the right .csv file than your source could work too.
- Also please try to send some more information: for example the url to the .csv file
- 因此,请尝试通过在浏览器中输入来确保您使用的 url 是正确的。如果它打开正确的 .csv 文件,那么您的源也可以工作。
- 另外请尝试发送更多信息:例如 .csv 文件的 url
回答by Santosh
Try below code :
试试下面的代码:
Copied from here(Not tested)
从这里复制(未测试)
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