我有一个 Excel 工作簿,它与公司服务器上的 SharePoint 列表建立了事件数据连接。 SP 列表只是当时 SP 文档库中所有文件的列表。我有一个 VBA 子例程,负责刷新此数据连接以查看当时库中的内容,然后将列表中的一些信息(文档名称、文档作者、提交时间戳等)移动到不同的工作簿。
SharePoint 站点使用 Active Directory 凭据进行身份验证,并且 SharePoint 还映射为运行代码的 PC 上的网络驱动器。但即便如此,刷新这个数据连接有时导致凭据提示看起来就像我帖子末尾的图像。如果我再次手动输入相同的 AD 凭据,则连接请求将通过身份验证,并且 Excel 中的列表会更新。
我的问题是:如何在我的代码中解释这一点?理想情况下,我希望它触发电子邮件警报或其他东西,但问题是执行连接刷新的代码行( ThisWorkbook.RefreshAll
)在处理凭据提示之前不会运行完成,所以我可以'不要在后面的代码行中设置任何处理程序。我无法进行此刷新,这可能会导致代码只卡在这条线上,直到有人碰巧注意到有问题(它在无人看管的 PC 上运行)。有人知道任何可以帮助解决我的问题的事情吗?
最佳答案
这实际上取决于您如何进行连接,在某些情况下这是不可能的,但您可以附加 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
关于excel - 是否可以在 VBA 中考虑由数据连接刷新激活的 SharePoint 凭据提示?,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/50179198/