用于驱动器映射的 VBA SharePoint 身份验证

Question

我已经成功地在 Excel 中使用 VBA 将驱动器映射到外联网 SharePoint 以下载文件，但是在部署中它可以在一个位置而不是另一个位置工作（可能的不同环境）。我很好奇是否有人对什么用户或系统设置会导致这种情况有任何见解。

在下面的代码中，我尝试将驱动器映射到 SharePoint，如果出现错误，处理程序会创建一个新的 excel 实例并将其保存到 SharePoint 网站。从本质上讲，这迫使 IE 打开并提示用户输入他们的登录详细信息，一旦提交，它就会对他们进行身份验证并上传文件。然后，他们能够将驱动器映射到 SharePoint。我在一组中遇到的问题是它会上传文件，但是他们不会保持身份验证以映射驱动器。更奇怪的是，当我逐步完成此过程时，用户在 IE 中登录到 SharePoint 站点。

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 身份验证。在捕获括号中，我添加了下面的代码行以弹出一个带有特定错误文本的消息窗口，并得到 403: Forbidden。下载 Fiddler 后，我可以看到该站点正在使用身份验证 cookie，我读过 WebClient 不支持。我一直在尝试捕获 cookie 并使用它进行身份验证，所以现在我没有收到 403 错误，而是从 Web 表单登录下载 HTML 代码。我需要弄清楚如何发送登录请求，捕获返回的 auth cookie，然后在发送 DownloadFile 请求时使用它。

System.Windows.Forms.MessageBox.Show(ex.Message);

Answer 1

对于它的价值，这是我最终使用的代码。我更容易学习足够的 C#（第一次使用 C#）来做到这一点，而不是试图用 VBA 来解决这个问题。参数（要下载的文件）作为字符串传递并拆分为数组。希望对您有所帮助。

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 中添加一个包含以下代码的模块，根据您的需要进行修改：

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