![](/img/trans.png)
[英]Excel VBA - URLDownloadToFile - Data missing in downloaded file
[英]Excel VBA URLDownloadToFile Does Not Retrieve Full File (Sharepoint API)
我正在尝试将 Sharepoint 365 链接到 Excel 工作簿中。 以前,我使用 wshell 将 Sharepoint 驱动器安装到我的计算机并在本地访问所有内容。 Sharepoint 365 不允许您这样做,所以我使用的是 API。 这是我的步骤:
使用 Sharepoint 365 API,我被困在第 3 步。
我正在使用 class 来实例化我的 Sharepoint session 并跟踪我的文件 ZA8CFDE63931BD59EB26AC9C64。 我的单元测试如下所示:
Sub testDownload()
Dim spFile As New sp365
Dim reqObj As Object
Dim jsonObj As Object
Dim dlStatus As Long
'first log in
spFile.login
'now get a request object that contains filenames and their relative URLs
Set reqObj = spFile.testQuery
'extract the info to a JSON object
Set jsonObj = jsonify(reqObj.responseText, "")
'hardcoding these parameters for now because I just want to download this one file
Debug.Print "Filename: " & jsonObj("d.results(0).Name")
Debug.Print "Relative Url: " & jsonObj("d.results(0).ServerRelativeUrl")
dlStatus = spFile.downloadTemporaryFile(jsonObj("d.results(0).ServerRelativeUrl"), jsonObj("d.results(0).Name"))
If dlStatus = 0 Then
Debug.Print "File Created"
Else
Debug.Print "File not created. Status = " & dlStatus
End If
out:
Exit Sub
End Sub
此处的相关代码位于downloadTemporaryFile
中。 显然,我使用的是 windows urlmon 代码,这似乎是在 Excel 中下载文件的事实上的方式:
Private 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
下载(临时)文件在这里:
Function downloadTemporaryFile(relativeUrl As String, fileName As String) As Boolean
On Error GoTo errHandler
'Download a file to a temporary path
'Keep the file inside the class object until it is closed
Dim userPath As String
Dim filePath As String
Dim url As String
Dim wshShell As Object
'Get the windows shell version for special folders
Set wshShell = CreateObject("WScript.Shell")
'get the documents folder for this computer
userPath = wshShell.SpecialFolders("MyDocuments")
'all logs are stored in <user>/Documents/logs
filePath = userPath & SHAREPOINT_TEMP_FOLDER
'Check if the 'SharepointTemp' folder exists
'if not, create the directory
If Dir(filePath, vbDirectory) = "" Then MkDir (filePath)
'Extract the site (this can differ based on the connected app)
'FYI: TENANT_DOMAIN is obtained during the Sharepoint Login procedure
url = "https://" & TENANT_DOMAIN & relativeUrl
'download it now
Debug.Print "Downloading to: " & filePath & fileName
Debug.Print "Downloading from: " & url
downloadTemporaryFile = URLDownloadToFile(0, url, filePath & fileName, 0, 0)
out:
Exit Function
errHandler:
logDump "Error", "sp365.downloadTemporaryFile", Err.Number & ";" & Err.source & ";" & Err.description
End Function
所以这似乎可行,并且 URLDownloadToFile 返回 0 (S_OK)。 但只有一小部分文件在我的下载文件夹中。 我在示例中尝试下载的文件是 2MB,我文件夹中的文件只有 4kb,它不会打开。 我什至还没有达到 cksum ,但它当然会失败。 我尝试过其他 Sharepoint 下载链接(如 .linkingUrl 和 .linkingUri),但我得到了相同的结果。 当我将上面构建的 url 粘贴到浏览器中时,文件下载得很好。
编辑:该文件实际上是一个 HTML 文件。 它看起来像这样:
<html><head><title>Working...</title>
</head><body><form method="POST" name="hiddenform" action="https://keysighttech.sharepoint.com/_forms/default.aspx">
<input type="hidden" name="code" value="..." />
<input type="hidden" name="id_token" value= "..."/>
<input type="hidden" name="session_state" value= "..." />
<input type="hidden" name="correlation_id" value="..."/>
<noscript><p>Script is disabled. Click Submit to continue.</p>
<input type="submit" value="Submit" /></noscript></form>
<script language="javascript">document.forms[0].submit();</script></body></html>
如何继续下载? 有什么建议么?
先感谢您!
我想到了。 基本上, UrlDownloadToFile
例程不通过任何身份验证。 因此,当我发送文件请求时,要么我收到 401 Unauthorized,一个基本上只是将我的请求吐回给我的错误,要么是我在上面发布的“提示”,这基本上是所有租户和身份验证的重定向方法。 因此,相反,我继续获得授权,并包含了我通常与标准 Sharepoint API 请求一起使用的标头,它以 stream 的形式将文件返回给我。 最终的 class function 看起来像这样:
Dim url As String
Dim filePtr As Long
Dim oResp() As Byte 'byte array to store the response object
Dim reqObj As Object
'make sure we can navigate to the right folder on people's computers
Dim userPath As String
Dim filePath As String
Dim wshShell As Object
Dim reqKey() As String
Dim reqVal() As String
'Get the windows shell version for special folders
Set wshShell = CreateObject("WScript.Shell")
'get the documents folder for this computer
userPath = wshShell.SpecialFolders("MyDocuments")
filePath = userPath & SHAREPOINT_TEMP_FOLDER
'Check if the 'SharepointTemp' folder exists
'if not, create the directory
If Dir(filePath, vbDirectory) = "" Then MkDir (filePath)
reqKey = sharepointHeadersKeys
reqVal = sharepointHeadersVals
'Extract the site (this can differ based on the connected app)
url = relativeUrl & SHAREPOINT_BINARY_REQUEST
Set reqObj = getRequest(url, bearer:=AuthToken.item("access_token"), key:=reqKey, value:=reqVal, blnAsync:=True)
'now the file should be in reqObj
oResp = reqObj.responseBody
'Create a local file and save the results
filePtr = FreeFile
Debug.Print "Downloading to: " & filePath & fileName
If Dir(filePath & fileName) <> "" Then Kill filePath & fileName
Open filePath & fileName For Binary As #filePtr
Put #filePtr, , oResp
Close #filePtr
现在我可以像以前一样使用临时文件夹中的文件了。 我正在使用从 API 调用返回并与我查询的文件 object 关联的metadata.uri
。 在我看来,这似乎是最简单和最干净的方法 - 特别是因为如果我正在寻找特定的文本或关键字,我可以搜索文件二进制文件并完全节省打开文件的开销。 但是,当然,我对其他方法和建议持开放态度。
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.