由于Cookie，使用VBA访问错误从sharepoint下载文件

我有一个存储在Sharepoint上的文件（主题文件），在加载到word之前，首先需要下载到临时目录中。这有一段时间有效，但最近我遇到了一个“拒绝访问错误”

我环顾四周，测试了其他库

CreateObject（“MSXML2.ServerXMLHTTP.6.0”）

，而不是

CreateObject（“Microsoft.XMLHTTP”）

有趣的是，我没有通过

CreateObject（“MSXML2.ServerXMLHTTP.6.0”）

获得访问错误消息，而是加载了一个带有此错误的页面：

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

我们不能让你登录 您的浏览器当前设置为阻止Cookie。您需要允许Cookie使用此服务。 Cookie是存储在计算机上的小文本文件，它告诉我们您何时登录。要了解如何允许Cookie，请查看web浏览器中的联机帮助

我希望有人知道为什么会发生此错误以及如何解决它

这是我使用的代码

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

---

因此，我设法在以下情况下解决了这个问题：

启用从和我们的SharePoint网站接受Cookie（还将其添加到受信任的网站中）

清除历史记录中的cookies

使用有效的“Microsoft.XMLHTTP”库（其他库似乎仍然不能正常工作）

---

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

另外。我必须首先使用ADO查询直接访问sharepoint库。此ADO连接处理身份验证并允许后续下载到该位置。可能还有另一种发送团队身份验证的方法，但这种方法很好用。（这也是从SP列表/库甚至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 downloadSP(ByVal url As String, ByVal nm As String) As Long
    DownloadFileFromWeb = URLDownloadToFile(0, url, nm, 0, 0) ' nm includes filename
End Function

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