VB Notebook UNC Path

These routines get the UNC path for a specific drive/letter or the drive letter for a specific UNC (if it exists).

First, in General|Declarations, include the following...
__________________________________________________________________________________________

'
' WNet Constants
'
Public Enum WNetResultConstants
    WN_SUCCESS = 0
    WN_NET_ERROR = 2
    WN_BAD_PASSWORD = 6
    WN_ERROR_BAD_DEVICE = 1200&
    WN_ERROR_CONNECTION_UNAVAIL = 1201&
    WN_ERROR_EXTENDED_ERROR = 1208&
    WN_ERROR_MORE_DATA = 234
    WN_ERROR_NOT_SUPPORTED = 50&
    WN_ERROR_NO_NET_OR_BAD_PATH = 1203&
    WN_ERROR_NO_NETWORK = 1222&
    WN_ERROR_NOT_CONNECTED = 2250&
End Enum
'
' API Calls
'
Private Declare Function WNetGetConnection Lib "mpr.dll" Alias "WNetGetConnectionA" _
                        (ByVal lpszLocalName As String, ByVal lpszRemoteName As String, _
                         cbRemoteName As Long) As Long

__________________________________________________________________________________________

This routine gets the UNC path for the specified drive letter. __________________________________________________________________________________________

Public Function GetUNCPath(sDriveLetter As String) As Variant

    On Error GoTo proc_err

    Dim sUNC As String
    Dim nReturn As Long
    Dim lpszLocalName As String
    Dim lpszRemoteName As String
    Dim cbRemoteName As Long
    Dim vResult As Variant

    lpszLocalName = sDriveLetter
    lpszRemoteName = String$(255, Chr$(32))
    cbRemoteName = Len(lpszRemoteName)
    nReturn = WNetGetConnection(lpszLocalName, lpszRemoteName, cbRemoteName)
    If nReturn = WN_SUCCESS Then
        vResult = Left$(lpszRemoteName, cbRemoteName)
    Else
        vResult = nReturn
    End If
    GetUNCPath = vResult
Exit Function

proc_err:
    GetUNCPath = Err.Number
End Function

__________________________________________________________________________________________

This routine gets the drive letter for the specified UNC path, if there is one. This routine uses the FileSystemObject so you will need to add a reference to the Microsoft Scripting Runtime to your application. You could also use alternative means to obtain the share names of installed drives.
__________________________________________________________________________________________

Public Function UNCToDriveLetter(sUNC As String) As String

    Dim FSO As New FileSystemObject
    Dim drvFind As Scripting.Drive
    Dim sDriveLetter As String

    For Each drvFind In FSO.Drives
        If UCase$(drvFind.ShareName) = UCase$(sUNC) Then
            sDriveLetter = drvFind.DriveLetter & ":"
        End If
    Next
    UNCToDriveLetter = sDriveLetter

End Function

__________________________________________________________________________________________