由于 cookie 导致使用 VBA 访问错误从 sharepoint 下载文件答案

【问题标题】：Download files from sharepoint using VBA access errors due to cookies由于 cookie 导致使用 VBA 访问错误从 sharepoint 下载文件
【发布时间】：2020-12-28 01:04:15
【问题描述】：

我有一个文件（主题文件）存储在 Sharepoint 上，首先需要下载到 temp 目录中，然后才能加载到 word 中。这工作了一段时间，但最近我收到“拒绝访问错误”。

我环顾四周并测试了其他库 CreateObject("MSXML2.ServerXMLHTTP.6.0") 而不是 CreateObject("Microsoft.XMLHTTP")。

有趣的是，我没有收到带有CreateObject("MSXML2.ServerXMLHTTP.6.0") 的访问错误消息，而是下载了一个带有此错误的页面：

[![错误信息截图][1]][1]

我们无法让您登录您的浏览器当前设置为阻止 cookie。您需要允许 cookie 使用此服务。 Cookie 是存储在您计算机上的小型文本文件，当您登录时会告诉我们。要了解如何允许 Cookie，请查看您的网络浏览器中的在线帮助。

我希望有人知道为什么会出现这个错误以及如何解决它

这是我使用的代码。

Public Sub Download(ByVal URL As String, ByVal FilePath As String, Optional ByVal Overwrite As Boolean = True)
    
    Dim iOverwrite, oStrm
    If (IsNull(Overwrite) Or Overwrite) Then
        iOverwrite = 2
    Else
        iOverwrite = 1
    End If
    
    Dim HttpReq As Object
    'NOTE: There are some issues downloading if not properly logged in! May need to loggin sharepoint again
    ' https://www.codeproject.com/Questions/1101499/Download-files-from-API-using-vbscript-cmd-prompt
    ' Based on https://stackoverflow.com/questions/22938194/xmlhttp-request-is-raising-an-access-denied-error
    'Set HttpReq = CreateObject("MSXML2.ServerXMLHTTP.6.0")
    Set HttpReq = CreateObject("Microsoft.XMLHTTP")
    'Set HttpReq = CreateObject("MSXML2.ServerXMLHTTP.3.0")
    
    HttpReq.Open "GET", URL, False, "username", "password"
    
    On Error GoTo ErrorHandler
        HttpReq.send
    On Error GoTo 0
    
    If HttpReq.Status = 200 Then
        Set oStrm = CreateObject("ADODB.Stream")
        oStrm.Open
        oStrm.Type = 1
        oStrm.Write HttpReq.responseBody
        oStrm.SaveToFile FilePath, iOverwrite ' 1 = no overwrite, 2 = overwrite
        oStrm.Close
    End If
    
    Exit Sub
    
ErrorHandler:
    MsgBox "The file could not be downloaded. Verify that you are logged in SharePoint with word and browser.", vbCritical, "Download error"
    Debug.Print "Download - Error Downloading file will not be downloaded - Error #: '" & Err.Number & "'. Error description: " & Err.description
End Sub```


  [1]: https://i.stack.imgur.com/pdH6v.png

【问题讨论】：

标签： vba sharepoint ms-word download

【解决方案1】：

我使用专门为此设计的导入功能。我使用 Sharepoint Teams 网站（无法发送用户/密码进行身份验证）。

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 downloadSP(ByVal url As String, ByVal nm As String) As Long
    DownloadFileFromWeb = URLDownloadToFile(0, url, nm, 0, 0) ' nm includes filename
End Function

另外。我必须先直接对共享点库使用 ADO 查询。此 ADO 连接处理身份验证并允许后续下载到位置。可能还有另一种发送 Teams 身份验证的方法，但这很好用。（这也是从 SP 列表/库甚至 Excel 文件中获取数据的好方法）

If testConnected Then downloadSP url, nm


Function testConnected() As Boolean
Dim cn As Object
Dim rs As Object
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.RecordSet")

listGUID = "B3657D15-5F5C-468E-B1C2-784B930FE2E6"
siteURL = "https://azuresite.sharepoint.com/sites/test/"
spSql = "Select * from ['https://azuresite.sharepoint.com/sites/test/SL%20Template/Forms/AllItems.aspx']"
cnStr = "Provider=Microsoft.ACE.OLEDB.16.0;WSS;IMEX=2;RetrieveIds=No;DATABASE=" & siteURL & "; LIST=" & listGUID & ";"

cn.ConnectionString = cnStr
On Error GoTo NotConnected
cn.Open
rs.Open spSql, cn, 1, 2
testConnected = True
    cn.Close
    
    Exit Function
NotConnected:
    testConnected = False
    
    Exit Function
End Function

【讨论】：

【解决方案2】：

所以我设法解决了这个问题：

允许接受来自：https://login.microsoftonline.com/ 和我们的 SharePoint 网站（也在受信任的网站中添加它们）的 cookie
从历史记录中清除 cookie
使用有效的“Microsoft.XMLHTTP”库（其他库似乎仍然无法正常工作）

【讨论】：