Run Time error 5

Question

 Function GetUNC(strMappedDrive As String) As String
    Dim objFso As FileSystemObject
    Set objFso = New FileSystemObject
    Dim strDrive As String
    Dim strShare As String
    'Separated the mapped letter from
    'any following sub-folders
    strDrive = objFso.GetDriveName(strMappedDrive)
    'find the UNC share name from the mapped letter
    strShare = objFso.Drives(strDrive).ShareName '<<<< this is the line that the code fails on
    'The Replace function allows for sub-folders
    'of the mapped drive
    GetUNC = Replace(strMappedDrive, strDrive, strShare)
    Set objFso = Nothing 'Destroy the object
End Function 

It works fine on my laptop and network, but when a colleague uses the same spreadsheet with the same code on their laptop and network the code throws a run-time error 5 exception 'invalid procedure call or argument' at the following line:

strShare = objFso.Drives(strDrive).ShareName

When I hover over the line of code I see: when I run the code to this point I see a file path.

My colleague has tried running the code on his local drive as well as a network drive with no success. We both have the same references selected as well. Does anyone know what I need to do to get this working on my colleagues machine?

Answer 1

Not entirely sure what the issue is, but it might be worth using an API call instead:

#If Win64 Then
    Declare PtrSafe Function WNetGetConnection32 Lib "MPR.DLL" Alias "WNetGetConnectionA" (ByVal lpszLocalName As String, ByVal lpszRemoteName As String, lSize As Long) As Long
#Else
    Declare Function WNetGetConnection32 Lib "MPR.DLL" Alias "WNetGetConnectionA" (ByVal lpszLocalName As String, ByVal lpszRemoteName As String, lSize As Long) As Long
#End If

Dim lpszRemoteName  As String * lBUFFER_SIZE
Dim lSize           As Long

Const NO_ERROR      As Long = 0&
Const lBUFFER_SIZE  As Long = 255&

Function GetUNC(ByRef strDriveLetter As String) As String
    strDriveLetter = UCase$(strDriveLetter) & ":"
    GetUNC = IIf(WNetGetConnection32(strDriveLetter, lpszRemoteName, lBUFFER_SIZE) = NO_ERROR, lpszRemoteName, "Error")
End Function

Then simply use something like:

MsgBox GetUNC("S")