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

由于驱动器是本地映射的，因此您应该能够直接转到文件并根据需要操作它，导入它，而不是具有活动的数据连接。与更严格的数据连接相比，它将为您提供更大的灵活性。

这个网站有一个很好的例子，展示了如何做你正在寻找的事情，但考虑到这种情况，我想象的方式会更有效。

这实际上取决于您如何进行连接，在某些情况下这是不可能的，但您可以附加 和 到 URL 以传递您的凭据，例如此处定义（对于其他语言，但您得到了要点）：UsernamePassword

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