Мой работодатель поручил мне найти способ автоматизации загрузки / обновления списков SharePoint с сервера SharePoint 2013, использующего проверку подлинности NTLM.Возможные способы сделать это - VBA или Powershell.Список, который я хочу получить, принадлежит деловому партнеру моей компании и содержит текущее состояние документов, которые должны быть написаны, проверены и опубликованы.Экспортированный список используется для сравнения их базы данных (SharePoint Server) и нашей (на базе Oracle).
Сначала я попытался использовать Powershell, но не смог выполнить аутентификацию NTLM и поэтому не получилвытащить любой список данных.Из того, что я читал в Интернете, у меня были бы учетные данные администратора, которых у меня нет.
После этого я попытался использовать макрос VBA.Я вручную экспортировал список в Excel и, следовательно, имел соединение, которое я думал использовать для извлечения данных из списка:
Sub UpdateandExport()
ActiveWorkbook.RefreshAll
Dim MyFileName As String
Dim CurrentWB As Workbook, TempWB As Workbook
Set CurrentWB = ActiveWorkbook
ActiveWorkbook.ActiveSheet.UsedRange.Copy
Set TempWB = Application.Workbooks.Add(1)
With TempWB.Sheets(1).Range("A1")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
End With
MyFileName = CurrentWB.Path & "\" & Left(CurrentWB.Name, Len (CurrentWB.Name) - 5) & ".csv"
Application.DisplayAlerts = False
TempWB.SaveAs Filename:="Export", FileFormat:=xlCSV, CreateBackup:=False, Local:=True
TempWB.Close SaveChanges:=False
Application.DisplayAlerts = True
ThisWorkbook.Close True
End Sub
Этот код работает для меня, но он предлагает мне вручную ввести свои учетные данные, которыеэто именно то, что я не хочу делать.
Поэтому я попытался сначала пройти аутентификацию, прежде чем извлекать данные списка:
Sub Export()
Dim user As String
Dim Password As String
user = "DOMAIN\USERNAME" 'I enter my credentials here
Password = "PASSWORD" 'I enter my credentials here
With CreateObject("Microsoft.XMLHTTP")
.Open "GET", "https://aaaa.bbbbbbbb.cc/dd-ee/ffffffffff/_vti_bin/", False
.setRequestHeader "Authorization", "NTLM" + Base64Encode(user + ":" + Password)
.Send
End With
ActiveWorkbook.RefreshAll
Dim MyFileName As String
Dim CurrentWB As Workbook, TempWB As Workbook
Set CurrentWB = ActiveWorkbook
ActiveWorkbook.ActiveSheet.UsedRange.Copy
Set TempWB = Application.Workbooks.Add(1)
With TempWB.Sheets(1).Range("A1")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
End With
MyFileName = CurrentWB.Path & "\" & Left(CurrentWB.Name, Len(CurrentWB.Name) - 5) & ".csv"
Application.DisplayAlerts = False
TempWB.SaveAs Filename:="Export", FileFormat:=xlCSV, CreateBackup:=False, Local:=True
TempWB.Close SaveChanges:=False
Application.DisplayAlerts = True
ThisWorkbook.Close True
End Sub
Function Base64Encode(sText)
Dim oXML, oNode
Set oXML = CreateObject("Msxml2.DOMDocument.3.0")
Set oNode = oXML.CreateElement("base64")
oNode.DataType = "bin.base64"
oNode.nodeTypedValue = Stream_StringToBinary(sText)
Base64Encode = oNode.Text
Set oNode = Nothing
Set oXML = Nothing
End Function
Function Stream_StringToBinary(Text)
Const adTypeText = 2
Const adTypeBinary = 1
'Create Stream object
Dim BinaryStream 'As New Stream
Set BinaryStream = CreateObject("ADODB.Stream")
'Specify stream type - we want To save text/string data.
BinaryStream.Type = adTypeText
'Specify charset For the source text (unicode) data.
BinaryStream.Charset = "us-ascii"
'Open the stream And write text/string data To the object
BinaryStream.Open
BinaryStream.WriteText Text
'Change stream type To binary
BinaryStream.Position = 0
BinaryStream.Type = adTypeBinary
'Ignore first two bytes - sign of
BinaryStream.Position = 0
'Open the stream And get binary data from the object
Stream_StringToBinary = BinaryStream.Read
Set BinaryStream = Nothing
End Function
Function Stream_BinaryToString(Binary)
Const adTypeText = 2
Const adTypeBinary = 1
'Create Stream object
Dim BinaryStream 'As New Stream
Set BinaryStream = CreateObject("ADODB.Stream")
'Specify stream type - we want To save text/string data.
BinaryStream.Type = adTypeBinary
'Open the stream And write text/string data To the object
BinaryStream.Open
BinaryStream.Write Binary
'Change stream type To binary
BinaryStream.Position = 0
BinaryStream.Type = adTypeText
'Specify charset For the source text (unicode) data.
BinaryStream.Charset = "us-ascii"
'Open the stream And get binary data from the object
Stream_BinaryToString = BinaryStream.ReadText
Set BinaryStream = Nothing
End Function
Это также успешно приводит к извлечению данных списка с сервера, но мне по-прежнему приходится вручную вводить свои учетные данные.
Поскольку я далеко не профессионал в VBA, я не могу найти какой-либо другой обходной путь и поэтому полностью полагаюсь на ваши знания, чтобы удовлетворить своих работодателей.пожелания.
Подводя итог: я ищу сценарий VBA для извлечения данных с сервера SharePoint 2013 с NTLM без ручной передачи учетных данных.У меня нет прав администратора для Сервера, и нет способа создать автоматический черновик с Сервера.