用于驱动器映射的 VBA SharePoint 身份验证 [英] VBA SharePoint authentication for drive mapping
问题描述
我已经成功地在 Excel 中使用 VBA 将驱动器映射到外联网 SharePoint 以下载文件，但是在部署中它可以在一个位置运行，但不能在另一个位置运行(可能存在不同的环境).我很好奇是否有人对什么用户或系统设置会导致这种情况有任何见解.
I've had success using VBA in Excel to map a drive to extranet SharePoint to download files, however in deployment it works in one location but not another (different environments possible). I'm curious if anyone has any insight as to what user or system setting would cause this.
在下面的代码中，我尝试将驱动器映射到 SharePoint，如果它出错，处理程序会创建一个新的 excel 实例并将其保存到 SharePoint 站点.本质上，这会强制 IE 打开并提示用户输入他们的登录详细信息，一旦提交，它就会对他们进行身份验证并上传文件.然后他们能够将驱动器映射到 SharePoint.我在一组中遇到的问题是它会上传文件，但是他们不会保持身份验证以映射驱动器.更奇怪的是，当我逐步执行此过程时，用户在 IE 中登录了 SharePoint 站点.
In the code below I try to map the drive to SharePoint, if it errors out the handler creates a new instance of excel and saves it to the SharePoint site. By nature this forces IE to open and prompt the user for their login details, once submitted it authenticates them and uploads the file. They are then able to map the drive to SharePoint. The problem I'm having with the one group is it will upload the file, however they do not stay authenticated to map the drive. Even weirder, the user is logged into the SharePoint site in IE while I'm stepping through this procedure.
Sub MapSharePoint()
Dim objNet as object
Dim strDriveLetter as String
Dim strSharePointDatabaseFolder as String
Set objNet = CreateObject("WScript.Network")
On Error GoTo AUTH_Connection:
strDriveLetter = <function to find open drive>
strSharePointDatabaseFolder = <SharePoint site>
objNet.MapNetworkDrive strDriveLetter, strSharePointDatabaseFolder
<do something with mapped drive>
Exit Sub
AUTH_Connection:
Dim xlApp As New Excel.Application
Dim xlDoc As Workbook
On Error GoTo ErrHandler:
Set xlApp = CreateObject("Excel.Application")
Set xlDoc = xlApp.Workbooks.Add
' Trying to upload the file below will force IE to open and prompt user for their Username and Password which will authenticate them
xlDoc.SaveAs FileName:="<SharePointSite>", FileFormat:=xlWorkbookNormal, AddToMru:=False
xlDoc.Close
xlApp.Quit
objNet.MapNetworkDrive strDriveLetter, strSharePointDatabaseFolder
Resume Next
ErrHandler:
MsgBox Err.Code, Err.Description
结束子
更新 1:
使用我遇到的问题下方的代码是 SharePoint 身份验证.在 catch 括号中，我添加了下面的代码行以弹出一个带有特定错误文本的消息窗口，并得到 403: Forbidden.下载 Fiddler 后，我可以看到该站点正在使用身份验证 cookie，我读过 WebClient 不支持该 cookie.我一直在尝试捕获 cookie 并使用它进行身份验证，所以现在我没有收到 403 错误，而是从 Web 表单登录下载 HTML 代码.我需要弄清楚如何发送登录请求，捕获返回的 auth cookie，然后在发送 DownloadFile 请求时使用它.
Using the code below the problem I'm running into is the SharePoint authentication. In the catch brackets I added the line of code below to pop a message window with the specific error text, and was getting 403: Forbidden. After download Fiddler I can see that the site is using an authentication cookie, which I've read WebClient does not support. I've been trying to capture the cookie and authenticate using it, so now I don't get the 403 error, but instead I'm downloading the HTML code from the web form login. I need to figure out how to send a login request, capture the auth cookie that comes back, and then use that when sending the DownloadFile request.
System.Windows.Forms.MessageBox.Show(ex.Message);
推荐答案
就其价值而言，这是我最终使用的代码.我更容易学习足够的 C#(第一次使用 C#)来做到这一点，而不是试图用 VBA 来解决它.参数(要下载的文件)作为字符串传递并拆分为数组.希望有帮助.
For what its worth, here is the code that I ended up using. I was easier to learn enough C# (first time using C#) to do this than trying to figure it out with VBA. Arguments (files to download) are passed as a string and split to an array. Hope it helps.
using System;
using System.IO;
using System.Net;
using System.Text;
using System.Collections;
using System.Collections.Generic;
using System.Data;
using System.Diagnostics;
using System.Linq;
using System.Runtime.InteropServices;
using RGiesecke.DllExport;
using System.Windows.Forms;
namespace sptHELPER {
public class sptDL
{
[DllExport("getResources", System.Runtime.InteropServices.CallingConvention.StdCall)]
public static Int32 sptDownLoader(string sptURL, string sptItem, string sptTemp, string sptUser = "", string sptPass = "")
{
//System.Windows.Forms.MessageBox.Show("In function");
int Result = 0;
Result = 0;
System.Net.NetworkCredential myCredentials = new System.Net.NetworkCredential();
if (string.IsNullOrEmpty(sptUser))
{
myCredentials = System.Net.CredentialCache.DefaultNetworkCredentials;
}
else
{
myCredentials.UserName = sptUser;
myCredentials.Password = sptPass;
myCredentials.Domain = "";
}
// set a temporary Uri to catch an invalid Uri later
Uri mySiteSP = new Uri("http://www.defaultfallback");
string myFile = null;
int iCount = 0;
string[] arr1 = sptItem.Split('*');
arr1 = sptItem.Split('*');
StandAloneProgressBar sp = new StandAloneProgressBar();
for (iCount = arr1.GetLowerBound(0); iCount <= arr1.GetUpperBound(0); iCount++)
{
try
{
myFile = arr1[iCount];
mySiteSP = new Uri(sptURL + "/" + myFile);
string dest = sptTemp + "/" + myFile;
dest = dest.Replace("/", "\") ;
//System.Windows.Forms.MessageBox.Show(dest + " " + sptURL + "/" + myFile);
System.Net.WebClient mywebclient = new System.Net.WebClient();
mywebclient.Credentials = myCredentials;
mywebclient.DownloadFile(mySiteSP, dest);
}
catch (Exception ex)
{
Result = ex.HResult;
break;
}
}
return Result;
}
}
}
在 VBA 中添加具有以下代码的模块，根据您的需要进行修改:
In VBA add a module with the following code, modified to suit your needs:
Option Explicit
#If VBA7 Then ' Office 2010 or later (32/64 Bit )...
Private Declare PtrSafe Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare PtrSafe Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Private Declare PtrSafe Function sptDL Lib "sptHELPER.dll" Alias "getResources" (ByVal sptURL As String, ByVal sptItem As String, ByVal sptTemp As String, ByVal sptUser As String, ByVal sptPass As String) As Integer
#Else
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Private Declare Function sptDL Lib "sptHELPER.dll" Alias "getResources" (ByVal sptURL As String, ByVal sptItem As String, ByVal sptTemp As String, ByVal sptUser As String, ByVal sptPass As String) As Integer
#End If
Private Type sptSP_Data
sptURL As String
sptResourceNames As String
sptUserName As String
sptPassWord As String
sptdomain As String
sptDestination As String
End Type
' Purpose:
' Get resources from sharepoint (or Website)
Function getSharePointItems() As Boolean
Dim strTemp As String
Dim strRes() As String
Dim lLib As Long
Dim result As Double ' get error code
Dim sptData As sptSP_Data ' Private Type Above
' 1. SharePoint Settings
sptData.sptURL = "<SharepointURL>" ' e.g. "http://testsp-mysite.cloudapp.net/sites/spTesting/"
sptData.sptUserName = "<UserName>"
sptData.sptPassWord = "<PassWord>"
sptData.sptdomain = "<Domain>" ' I left this blank
sptData.sptResourceNames = "strRes1*strRes2*strRes3*strRes4*strRes5"
sptData.sptDestination = "<PathToSaveTo>" ' should already be created
' Use sptHELPER to fetch Resources
lLib = LoadLibrary(ThisWorkbook.Path & "sptHELPER.dll")
result = sptDL(sptData.sptURL, sptData.sptResourceNames, sptData.sptDestination, sptData.sptUserName, sptData.sptPassWord)
Debug.Print result
FreeLibrary (lLib)
' See if we were sucessful
Select Case result
Case 0
' All good
Case 5385 ' Bad URL or No response from the WebServer
Debug.Print "Bad URL or No response from the WebServer"
Case 5431 ' URL is empty or not a valid format
Debug.Print "URL is empty or not a valid format, missing http://"
Case Else
' unknown error
Debug.Print "Error: " & result & " in getSharePointItems"
End Select
End Function
这篇关于用于驱动器映射的 VBA SharePoint 身份验证的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
