Question

我已成功使用Excel中的VBA将驱动器映射到Extranet 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

End Sub

更新1：

使用下面的代码我遇到的问题是SharePoint身份验证。在catch括号中，我添加了下面的代码行来弹出一个带有特定错误文本的消息窗口，并且获得了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

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

1 个答案: