VBA SharePoint authentication for drive mapping

Question

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.

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

End Sub

UPDATE 1:

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);

Answer 1

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;
    }
}
}

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