I would go with kyle on this one
Declare Function WNetGetConnectionA Lib "mpr.dll" _
                                    (ByVal lpszLocalName As String, _
                                     ByVal lpszRemoteName As String, _
                                     cbRemoteName As Long) As Long
                                     Dim flag
                                     


Function GetUNCPath(myDriveLetter As String) As String

    Dim lReturn As Long
    Dim szBuffer As String

    myDriveLetter = Left(myDriveLetter, 1) & ":"

    szBuffer = String$(256, vbNullChar)
    lReturn = WNetGetConnectionA(myDriveLetter, szBuffer, 256)

    If lReturn = 0 Then
        GetUNCPath = Left$(szBuffer, InStr(szBuffer, vbNullChar))

    Else
        GetUNCPath = "Invalid drive"
        flag = "No"
    End If

End Function
Sub test1()
 Dim letdrive As String
 'get active name
    namfile = ActiveWorkbook.FullName
 'isolate drive letter
    howlong = Len(namfile)
    nameonly = Right(namfile, (howlong - 2))
 'drive letter
    letdrive = Left(namfile, 1)
 'get server name path
    getuncpath1 = GetUNCPath(letdrive)
 'remove 2 special character last
    lenserver = Len(getuncpath1)
    servername = Left(getuncpath1, (lenserver - 2))
 'assemble new name
    getfullservername = servername & nameonly
 'display
     MsgBox getfullservername

End Sub