问题
My employer tasked me with finding a way to automate downloading/updating SharePoint lists from a SharePoint 2013 Server that uses NTLM authentication. Possible means to do this are VBA or Powershell. The list I want to pull belongs to a business partner of my company and it holds the current state of Documents that are to be written, reviewed and released. The exported list is used for comparison between their database(the SharePoint Server) and ours(Oracle based).
I first tried using Powershell, but wasn't able to perform the NTLM Authentication and therefore didn't get to pull any list data. From what I read online, I would've had to have admin credentials, which I don't have.
After that, I tried using a VBA macro. I manually exported the list to Excel and hence had a connection, which I thought to use for pulling the list data:
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
This code works for me, but it prompts me to manually insert my credentials, which is exactly what I don't want to do.
Therefore, I tried to authenticate first, before pulling the list data:
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
This also succeeds in pulling list data from the server, but I still have to manually insert my credentials.
As I am nowhere near being a professional at VBA, I can't come up with any other workaround and therefore am totally reliant on your knowledge to satisfy my employers wishes.
To sum it up: I'm looking for a VBA script to pull data from a SharePoint 2013 Server with NTLM without manually passing credentials. I don't have admin rights to the Server and there's no way to create an automatic draft from the Server.
回答1:
I will use VBA to launch PowerShell and run PowerShell script to download whatever data wanted. It's pretty easy to launch another program in VBA, so I am not going to describe it.
Here is the PowerShell script to authenticate with NTLM by giving user/password, BTW, you can use UseDefaultCredentials=$True in the following code to use currently logged in user.
For these headers, I just copied from Fiddler, you will have to correct them for your usage.
$url = "https://xxx.yyy/team/data.csv"
$request = [System.Net.WebRequest]::Create($url)
$request.Method="Get"
$credCache = new-object System.Net.CredentialCache
$creds = new-object System.Net.NetworkCredential("username","password", "domain")
$credCache.Add("https://xxx.yyy", "NTLM", $creds)
$request.Credentials = $credCache
$request.Headers.Add("Upgrade-Insecure-Requests", "1")
$request.Headers.Add("DNT", "1")
$request.Headers.Add("Accept-Encoding", "gzip, deflate, br")
$request.Headers.Add("Accept-Language", "en-US,en;q=0.9")
$request.UserAgent = "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/71.0.3578.98 Safari/537.36"
$request.Accept = "text/html,application/xhtml+xml,application/xml;q=0.9,image/webp,image/apng,*/*;q=0.8"
$response = $request.GetResponse()
$requestStream = $response.GetResponseStream()
$readStream = New-Object System.IO.StreamReader $requestStream
$data = $readStream.ReadToEnd()
If all good, in Fiddler, you will see something like following from http headers,
PowerShell to do the auth and download work, VBA to load the downloaded file.
来源：https://stackoverflow.com/questions/53669718/how-to-use-vba-or-powershell-to-export-lists-from-sharepoint-server-with-ntlm-au