Hello Friends,

I have used/tested this and this ok You can use this code

To a form add a command button (Command1),a label (Label1) and two text boxes (Text1, Text2). Add the following to the form:

Option Explicit


Private Const ERROR_SUCCESS As Long = 0
Private Const MAX_PATH As Long = 260

Private Declare Function WNetGetConnection Lib "mpr.dll" _
Alias "WNetGetConnectionA" _
(ByVal lpszLocalName As String, _
ByVal lpszRemoteName As String, _
cbRemoteName As Long) As Long

Private Declare Function PathIsNetworkPath Lib "shlwapi.dll" _
Alias "PathIsNetworkPathA" _
(ByVal pszPath As String) As Long

Private Declare Function PathIsUNC Lib "shlwapi.dll" _
Alias "PathIsUNCA" _
(ByVal pszPath As String) As Long

Private Declare Function PathStripToRoot Lib "shlwapi.dll" _
Alias "PathStripToRootA" _
(ByVal pPath As String) As Long

Private Declare Function PathSkipRoot Lib "shlwapi.dll" _
Alias "PathSkipRootA" _
(ByVal pPath As String) As Long

Private Declare Function lstrlenW Lib "kernel32" _
(ByVal lpString As Long) As Long

Private Declare Function lstrcpyA Lib "kernel32" _
(ByVal RetVal As String, ByVal Ptr As Long) As Long

Private Declare Function lstrlenA Lib "kernel32" _
(ByVal Ptr As Any) As Long



Private Sub Form_Load()

Command1.Caption = "Get UNC"

End Sub


Private Sub Command1_Click()

Dim sLocalName As String

'Change to a valid mapped share. The string can
'be either the drive letter alone, or contain
'path info below the mapped drive (as shown).
'When this is the case, the second routine below
'(GetUncFullPathFromMappedDrive) returns the
'full UNC path including the folders.

sLocalName = "W:\target\LabInfo"

Label1.Caption = sLocalName
Text1.Text = GetUncFromMappedDrive(sLocalName)
Text2.Text = GetUncFullPathFromMappedDrive(sLocalName)

End Sub


Private Function GetUncFromMappedDrive(sLocalName As String) As String

Dim sLocalRoot As String
Dim sRemoteName As String
Dim cbRemoteName As Long

sRemoteName = Space$(MAX_PATH)
cbRemoteName = Len(sRemoteName)

'get the drive letter
sLocalRoot = StripPathToRoot(sLocalName)

'if drive letter is a network share,
'resolve the share UNC name
If IsPathNetPath(sLocalRoot) Then
If WNetGetConnection(sLocalRoot, _
sRemoteName, _
cbRemoteName) = ERROR_SUCCESS Then

'this assures the retrieved name is in
'fact a valid UNC path.
If IsUNCPathValid(sRemoteName) Then
GetUncFromMappedDrive = TrimNull(sRemoteName)
End If

End If
End If

End Function


Private Function GetUncFullPathFromMappedDrive(sLocalName As String) As String

Dim sLocalRoot As String
Dim sRemoteName As String
Dim sRemotePath As String
Dim cbRemoteName As Long

sRemoteName = Space$(MAX_PATH)
cbRemoteName = Len(sRemoteName)

sLocalRoot = StripPathToRoot(sLocalName)

'modification to the GetUncFromMappedDrive()
'routine. Save the path info to a variable for
're-adding below.
sRemotePath = StripRootFromPath(sLocalName)

If IsPathNetPath(sLocalRoot) Then
If WNetGetConnection(sLocalRoot, _
sRemoteName, _
cbRemoteName) = ERROR_SUCCESS Then

sRemoteName = QualifyPath(TrimNull(sRemoteName)) & sRemotePath

If IsUNCPathValid(sRemoteName) Then
GetUncFullPathFromMappedDrive = sRemoteName
End If

End If
End If
End Function


Private Function QualifyPath(spath As String) As String

'add trailing slash if required
If Right$(spath, 1) <> "\" Then
QualifyPath = spath & "\"
Else
QualifyPath = spath
End If

End Function


Private Function IsPathNetPath(ByVal spath As String) As Boolean

'Determines whether a path represents network resource.
IsPathNetPath = PathIsNetworkPath(spath) = 1

End Function


Private Function IsUNCPathValid(ByVal spath As String) As Boolean

'Determines if string is a valid UNC
IsUNCPathValid = PathIsUNC(spath) = 1

End Function


Private Function StripPathToRoot(ByVal spath As String) As String

'Removes all of the path except for
'the root information (ie drive. Also
'removes any trailing slash.
Dim pos As Integer

Call PathStripToRoot(spath)

pos = InStr(spath, Chr$(0))
If pos Then
StripPathToRoot = Left$(spath, pos - 2)
Else
StripPathToRoot = spath
End If

End Function


Private Function TrimNull(startstr As String) As String

TrimNull = Left$(startstr, lstrlenW(StrPtr(startstr)))

End Function


Private Function StripRootFromPath(ByVal spath As String) As String

'Parses a path, ignoring the drive
'letter or UNC server/share path parts
StripRootFromPath = TrimNull(GetStrFromPtrA(PathSkipRoot(spath)))

End Function


Private Function GetStrFromPtrA(ByVal lpszA As Long) As String

'Given a pointer to a string, return the string
GetStrFromPtrA = String$(lstrlenA(ByVal lpszA), 0)
Call lstrcpyA(ByVal GetStrFromPtrA, ByVal lpszA)

End Function


Kamlesh Gujarathi.
kamlesh@itshastra.com