下载VBA中的文件并存储它

Question

我需要下载一个从REST搜索中获得的文件。 URL是这样的：

https://abc.def/geh/servlet/rest/vault?oid=xxx&expr=files.file1

（我需要它编辑由于隐私原因..）

该文件应该是一个Nastran的计算结果，它可以被看作由一个简单的Texteditor。 Extension是.pch，它相对较大（〜21mb）

这怎么可以在VBA中实现？

Answer 1

首先 - 链接不起作用。其次，根据HTTP请求的输出，可以有两种方法。

如果输出的是你可以使用下面的代码文件：

Sub DownloadFile(url As String, filePath As String) 

    Dim WinHttpReq As Object, attempts As Integer 
    attempts = 3 
    On Error GoTo TryAgain 
TryAgain: 
    attempts = attempts - 1 
    Err.Clear 
    If attempts > 0 Then 
     Set WinHttpReq = CreateObject("Microsoft.XMLHTTP") 
     WinHttpReq.Open "GET", url, False 
     WinHttpReq.send 

     If WinHttpReq.Status = 200 Then 
      Set oStream = CreateObject("ADODB.Stream") 
      oStream.Open 
      oStream.Type = 1 
      oStream.Write WinHttpReq.responseBody 
      oStream.SaveToFile filePath, 2 ' 1 = no overwrite, 2 = overwrite 
      oStream.Close 
     End If 
    End If 
End Sub 

如果输出是一个简单的文本HTML响应您可以将输出保存到一个文件

Function GetXMLHTTPResult(url As String) 
    Dim XMLHTTP As Object, attempts As Integer 
    attempts = 3 
    On Error GoTo TryAgain 
TryAgain: 
    attempts = attempts - 1 
    Err.Clear 
    If attempts > 0 Then 
     Set XMLHTTP = CreateObject("MSXML2.serverXMLHTTP") 
     XMLHTTP.Open "GET", url, False 
     XMLHTTP.setRequestHeader "Content-Type", "text/xml" 
     XMLHTTP.setRequestHeader "Cache-Control", "no-cache" 
     XMLHTTP.setRequestHeader "Pragma", "no-cache" 
     XMLHTTP.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; rv:25.0) Gecko/20100101 Firefox/25.0" 
     XMLHTTP.send 
     GetXMLHTTPResult = XMLHTTP.ResponseText 
    End If 
End Function 
Sub SaveFile(url) 
     res = GetXMLHTTPResult(url) 
     Open "C:\res.txt" For Output As #1 
     Write #1, res 
     Close #1 
End Sub 

Answer 2

如果该文件已经存在于服务器上，并且不必通过查询等方式构建，您可以使用如下API调用：

Option Explicit 

#If VB7 Then 
    Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _ 
    (ByVal pCaller As LongPtr, ByVal szURL As String, ByVal szFileName As String, _ 
    ByVal dwReserved As LongPtr, ByVal lpfnCB As LongPtr) As Long 
#Else 
    Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _ 
    (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, _ 
    ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long 
#End If 

Sub SO() 

Dim fileURL As String, saveLocation As String 

fileURL = "https://abc.def/geh/servlet/rest/vault?oid=xxx&expr=files.file1" 
saveLocation = "C:\Users\bloggsj\desktop\files.file1" 

MsgBox "Download completed: " & (URLDownloadToFile(0, fileURL, saveLocation, 0, 0) = 0) 

End Sub