excel - 是否可以在 VBA 中考虑由数据连接刷新激活的 SharePoint 凭据提示？

Question

我有一个 Excel 工作簿，它与公司服务器上的 SharePoint 列表建立了事件数据连接。 SP 列表只是当时 SP 文档库中所有文件的列表。我有一个 VBA 子例程，负责刷新此数据连接以查看当时库中的内容，然后将列表中的一些信息(文档名称、文档作者、提交时间戳等)移动到不同的工作簿。

SharePoint 站点使用 Active Directory 凭据进行身份验证，并且 SharePoint 还映射为运行代码的 PC 上的网络驱动器。但即便如此，刷新这个数据连接有时导致凭据提示看起来就像我帖子末尾的图像。如果我再次手动输入相同的 AD 凭据，则连接请求将通过身份验证，并且 Excel 中的列表会更新。

我的问题是:如何在我的代码中解释这一点？理想情况下，我希望它触发电子邮件警报或其他东西，但问题是执行连接刷新的代码行( ThisWorkbook.RefreshAll )在处理凭据提示之前不会运行完成，所以我可以'不要在后面的代码行中设置任何处理程序。我无法进行此刷新，这可能会导致代码只卡在这条线上，直到有人碰巧注意到有问题(它在无人看管的 PC 上运行)。有人知道任何可以帮助解决我的问题的事情吗？

Answer 1

这实际上取决于您如何进行连接，在某些情况下这是不可能的，但您可以附加 Username和 Password到 URL 以传递您的凭据，例如在此处定义(对于其他语言，但您了解要点):
https://www.connectionstrings.com/sharepoint/
现在的实际情况是，您可能没有进行 REST 连接，您可能必须按照此处的讨论:https://www.experts-exchange.com/questions/28628642/Excel-VBA-code-using-authentication-to-SharePoint.html
他们建议:

Public Sub CopyToSharePoint()
On Error GoTo err_Copy

Dim xmlhttp
Dim sharepointUrl
Dim sharepointFileName
Dim tsIn
Dim sBody
Dim LlFileLength As Long
Dim Lvarbin() As Byte
Dim LobjXML As Object
Dim LstrFileName As String
Dim LvarBinData As Variant
Dim PstrFullfileName As String
Dim PstrTargetURL As String
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim fldr As Folder
Dim f As File
Dim pw As String
Dim UserName As String
Dim RetVal
Dim I As Integer
Dim totFiles As Integer
Dim Start As Date, Finish As Date

UserName = InputBox(Username?") pw = InputBox("Password?")

sharepointUrl = "[http path to server]/[server folder to write to]"

Set LobjXML = CreateObject("Microsoft.XMLHTTP")

Set fldr = fso.GetFolder(CurrentProject.Path & "\[folder with files to
upload]\") totFiles = fldr.Files.Count

For Each f In fldr.Files

  sharepointFileName = sharepointUrl & f.Name

'****************************   Upload text files 
**************************************************

  If Not sharepointFileName Like "*.gif" And Not sharepointFileName
Like "*.xls" And Not sharepointFileName Like "*.mpp" Then

    Set tsIn = f.OpenAsTextStream
    sBody = tsIn.ReadAll
    tsIn.Close
  
    Set xmlhttp = CreateObject("MSXML2.XMLHTTP.4.0")
    xmlhttp.Open "PUT", sharepointFileName, False, UserName, Password
    xmlhttp.Send sBody
       Else

'****************************   Upload binary files 
**************************************************
  
    PstrFullfileName = CurrentProject.Path & "\[folder with files to upload]\" & f.Name
    LlFileLength = FileLen(PstrFullfileName) - 1

    ' Read the file into a byte array.
    ReDim Lvarbin(LlFileLength)
    Open PstrFullfileName For Binary As #1
    Get #1, , Lvarbin
    Close #1

    ' Convert to variant to PUT.
    LvarBinData = Lvarbin
    PstrTargetURL = sharepointUrl & f.Name


    ' Put the data to the server, false means synchronous.
    LobjXML.Open "PUT", PstrTargetURL, False, Username, Password

   ' Send the file in.
    LobjXML.Send LvarBinData

  End If
     I = I + 1   RetVal = SysCmd(acSysCmdSetStatus, "File " & I & " of " & totFiles & " copied...")    Next f

  RetVal = SysCmd(acSysCmdClearStatus)   Set LobjXML = Nothing   Set
fso = Nothing


err_Copy: If Err <> 0 Then   MsgBox Err & " " & Err.Description End If

End Sub 

实际上，我认为这个答案可能会让你走上正确的道路: https://sharepoint.stackexchange.com/questions/255264/sharepoint-api-and-vba-access-denied
无论如何，这是一个问题，祝你好运。我最好使用 MS Access 将列表链接为表格，然后使用 Excel 调用 Access 并获得我需要的东西。

Private Sub cmdSyncSP_Click()
On Error GoTo ErrorCode
    Application.Cursor = xlWait
    Dim app As New Access.Application
    'Set app = CreateObject("Application.Access")
    app.OpenCurrentDatabase Application.ActiveWorkbook.Path & "\SP_Sync.accdb"
    app.Visible = False
    app.Run "doManualCheck"
    app.CloseCurrentDatabase
    Set app = Nothing
    MsgBox "Sync has finished.  Refresh and proceed to copy your data.", vbInformation + vbOKOnly, "Success"
ExitCode:
    On Error Resume Next
    Application.Cursor = xlDefault
    Exit Sub
ErrorCode:
    MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "Sync Error"
    Resume ExitCode
End Sub