如何使用VBA或Powershell将具有NTLM身份验证的Sharepoint服务器中的列表导出到Excel [英] How to use VBA or Powershell to export lists from Sharepoint server with NTLM Authentication to Excel

问题描述

我的雇主要求我找到一种方法，该方法可以自动从使用NTLM身份验证的SharePoint 2013 Server下载/更新SharePoint列表.可能的方法是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脚本，以在不手动传递凭据的情况下从具有NTLM的SharePoint 2013 Server中提取数据. 我没有服务器的管理员权限，无法从服务器创建自动草稿.

解决方案

我将使用VBA启动PowerShell，并运行PowerShell脚本以下载所需的任何数据.在VBA中启动另一个程序非常容易，因此我将不对其进行描述.

以下是通过提供用户名/密码BTW来通过NTLM进行身份验证的PowerShell脚本，您可以在以下代码中使用UseDefaultCredentials=$True来使用当前登录的用户.

对于这些标头，我只是从Fiddler复制而来，您将必须根据使用情况对其进行更正.

$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()

如果一切正常，在Fiddler中，您会从http标头中看到以下内容，

PowerShell进行身份验证和下载工作，VBA加载下载的文件.

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.

解决方案

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.

这篇关于如何使用VBA或Powershell将具有NTLM身份验证的Sharepoint服务器中的列表导出到Excel的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！