how get UNC path with worksheet function

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

Thanks for any help.
I can get the UNC path with some VB code that someone else made, but is
there a worksheet function that can get it? I would like to display on the
worksheet the UNC path, rather than just the drive mapping and path.
Thanks again.
 
Hello Ian,

Insert a VBA module into your Workbook and paste the following code
into it. To return the UNC path, you can call the macro as a
formula...

=GetUNCPath("D:")

'<Begin Macro Code>
Private Declare Function WNetGetConnection _
Lib "mpr.dll" _
Alias "WNetGetConnectionA" _
(ByVal lpszLocalName As String, _
ByVal lpszRemoteName As String, _
cbRemoteName As Long) As Long

Private Const ERROR_BAD_DEVICE = 1200&
Private Const ERROR_CONNECTION_UNAVAIL = 1201&
Private Const ERROR_EXTENDED_ERROR = 1208&
Private Const ERROR_MORE_DATA = 234
Private Const ERROR_NOT_SUPPORTED = 50&
Private Const ERROR_NO_NET_OR_BAD_PATH = 1203&
Private Const ERROR_NO_NETWORK = 1222&
Private Const ERROR_NOT_CONNECTED = 2250&
Private Const NO_ERROR = 0

Public Function GetUNCPath(DriveLetter As String) As String

Dim cbRemoteName As Long
Dim lpszLocalName As String
Dim lpszRemoteName As String
Dim Msg As String
Dim RetVal'

On Local Error GoTo UNC_Error

If Right(DriveLetter, 1) <> ":" Then DriveLetter = DriveLetter &
":"
lpszLocalName = DriveLetter

Start:
lpszRemoteName = String$(260, Chr$(0))
cbRemoteName = Len(lpszRemoteName)

RetVal = WNetGetConnection(lpszLocalName, lpszRemoteName,
cbRemoteName)

Select Case RetVal
Case NO_ERROR
GetUNCPath = Left$(lpszRemoteName, cbRemoteName)
Exit Function
Case ERROR_BAD_DEVICE
Msg = "Bad Device Specified"
Case ERROR_CONNECTION_UNAVAIL
Msg = "Connection is Un-Available"
Case ERROR_EXTENDED_ERROR
Msg = "An Error occurred on the Network"
Case ERROR_MORE_DATA
Msg = "More Data - The Buffer is Full"
Case ERROR_NOT_SUPPORTED
Msg = "Feature not Supported"
Case ERROR_NO_NET_OR_BAD_PATH
Msg = "No Network Available or Bad Path"
Case ERROR_NO_NETWORK
Msg = "No Network Available"
Case ERROR_NOT_CONNECTED
Msg = "Not Connected to a Network"
End Select

UNC_Error:

RetVal = MsgBox("The following error occurred while" & vbCrLf _
& "retreiving the UNC Path..." & vbCrLf & vbLf _
& Msg, vbCritical + vbRetryCancel)

If RetVal = vbRetry Then GoTo Start

GetUNCPath = ""

End Function
'<End Macro Code>

Sincerely,
Leith Ross
 
I saved parts of this from a Rob Bovey post:

Option Explicit
Declare Function WNetGetConnectionA Lib "mpr.dll" _
(ByVal lpszLocalName As String, _
ByVal lpszRemoteName As String, _
cbRemoteName As Long) As Long

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 = "Error"
End If

End Function


Sub auto_open()
Dim myStr As String
Dim myUNCPath As String

myStr = ThisWorkbook.Path
If Mid(myStr, 2, 1) = ":" Then
myUNCPath = GetUNCPath(Left(myStr, 2))
myStr = myUNCPath & Mid(myStr, 3)
End If

Worksheets("sheet1").Range("a1").Value = myStr
End Sub

I don't have a network path to test this. It may be missing some backslashes.

Good luck.
 
Back
Top