excel - Excel VBA URLDownloadToFile 不检索完整文件（Sharepoint API）

Question

我正在尝试将 Sharepoint 365 链接到 Excel 工作簿。以前，我使用 wshell 将 Sharepoint 驱动器安装到我的计算机并在本地访问所有内容。Sharepoint 365 不允许你这样做，所以我正在使用 API。这是我的步骤：

登录 Sharepoint 并获取访问令牌（OAuth2 握手）
搜索文件或导航 Sharepoint 列表/文件夹/文件树以查找文件（这是通过各种 Sharepoint API 调用返回我正在寻找的相关对象来完成的）
将文件从 Sharepoint 下载到本地驱动器（目前只读操作）
我一直在使用一堆自动化程序来与从各种文件下载的数据进行交互，这不会改变。

使用 Sharepoint 365 API，我被困在第 3 步。

我正在使用一个类来实例化我的 Sharepoint 会话并跟踪我的文件对象。我的单元测试如下所示：

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>

如何继续下载？有什么建议么？

先感谢您！

score 0 · Accepted Answer

我想到了。基本上，该UrlDownloadToFile例程不通过任何身份验证。因此，当我发送文件请求时，要么我收到 401 Unauthorized，一个基本上只是将我的请求吐回给我的错误，要么是我在上面发布的“提示”，这基本上是所有租户和身份验证的重定向方法。因此，相反，我继续获得授权，并包含了我通常与标准 Sharepoint API 请求一起使用的标头，它以比特流的形式将文件返回给我。最终的类函数看起来像这样：

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

现在我可以像以前一样使用临时文件夹中的文件了。我正在使用metadata.uri从 API 调用返回的并与我查询的文件对象相关联。在我看来，这似乎是最简单和最干净的方法 - 特别是因为如果我正在寻找特定的文本或关键字，我可以搜索文件二进制文件并完全节省打开文件的开销。但是，当然，我对其他方法和建议持开放态度。

excel - Excel VBA URLDownloadToFile 不检索完整文件（Sharepoint API）

1 回答 1

Related

Reference