Driver FileName to UNC (addentum)

[cm]

I add some lines more for explain my needs.

must get a UNC Filename from a fullname like this:

p:\public\workbook.xls

where 'p' is a mapped drive connected to \\Machine\Shared

=============================
and i want to get the string:

\\Machine\Shared\Public\workbook.xls
=============================

Does anybody know how to do it with VBA. ?

Thank you.

[Jim Rech]

Use the GetUNCPathFromDriveLetter function below to convert a drive letter
to its UNC path and then do a string substitution:

--
Jim Rech
Excel MVP

''Add these at the top of your VB module
Declare Function WNetGetConnection32 Lib "MPR.DLL" Alias _
"WNetGetConnectionA" (ByVal lpszLocalName As String, ByVal _
lpszRemoteName As String, lSize As Long) As Long
Const NO_ERROR As Long = 0
Const lBUFFER_SIZE As Long = 255

''Returns UNC path from a mapped drive letter
Function GetUNCPathFromDriveLetter(Driveletter As String) As String
Dim cbRemoteName As Long
Dim lStatus As Long
Dim lpszRemoteName As String
Dim lSize As Long
Driveletter = Driveletter & ":"
cbRemoteName = lBUFFER_SIZE
lpszRemoteName = lpszRemoteName & Space(lBUFFER_SIZE)
lStatus = WNetGetConnection32(Driveletter, lpszRemoteName, _
cbRemoteName)
If lStatus = NO_ERROR Then
GetUNCPathFromDriveLetter = lpszRemoteName
End If
End Function

[Tom Ogilvy]

Jim's response certainly seems like the simpler way to go, but if you want
to use the method in the first article, you could adapt it as follows - I
don't know the relative merits of each method, but I know this did work for
me as did Jim's.

Just insert a new module and copy and paste this into it. Then make the
changes to showpath as indicated.

Option Explicit
Private Const RESOURCETYPE_ANY = &H0
Private Const RESOURCE_CONNECTED = &H1
Private Type NETRESOURCE
dwScope As Long
dwType As Long
dwDisplayType As Long
dwUsage As Long
lpLocalName As Long
lpRemoteName As Long
lpComment As Long
lpProvider As Long
End Type

Private Declare Function WNetOpenEnum Lib "mpr.dll" Alias _
"WNetOpenEnumA" (ByVal dwScope As Long, ByVal dwType As Long, _
ByVal dwUsage As Long, lpNetResource As Any, lphEnum As Long) _
As Long
Private Declare Function WNetEnumResource Lib "mpr.dll" Alias _
"WNetEnumResourceA" (ByVal hEnum As Long, lpcCount As Long, _
lpBuffer As Any, lpBufferSize As Long) As Long
Private Declare Function WNetCloseEnum Lib "mpr.dll" ( _
ByVal hEnum As Long) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" _
(ByVal lpString As Any) As Long
Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" _
(ByVal lpString1 As Any, ByVal lpString2 As Any) As Long

'**************************
'* In Sub ShowPath below,
'* Change sSTr to point to your path
'* The run ShowPath
'**************************

Public Sub ShowPath()
Dim sStr As String, sLetter As String
Dim sUNCPath As String
sStr = "Y:\indep99\Steph2\comelv1.xls"
sLetter = Left(sStr, 2)
sUNCPath = LetterToUNC(sLetter)
If sUNCPath <> "Drive Letter Not Found" Then
MsgBox "Full Path: " & sUNCPath & Right(sStr, Len(sStr) - 2)
Else
MsgBox sUNCPath
End If
MsgBox LetterToUNC("Y:")
End Sub

Function LetterToUNC(DriveLetter As String) As String
Dim hEnum As Long
Dim NetInfo(1023) As NETRESOURCE
Dim entries As Long
Dim nStatus As Long
Dim LocalName As String
Dim UNCName As String
Dim i As Long
Dim r As Long ' Begin the enumeration
nStatus = WNetOpenEnum(RESOURCE_CONNECTED, RESOURCETYPE_ANY, _
0&, ByVal 0&, hEnum)
LetterToUNC = "Drive Letter Not Found"
'Check for success from open enum
If ((nStatus = 0) And (hEnum <> 0)) Then
' Set number of entries
entries = 1024
' Enumerate the resource
nStatus = WNetEnumResource(hEnum, entries, NetInfo(0), _
CLng(Len(NetInfo(0))) * 1024) ' Check for success
If nStatus = 0 Then
For i = 0 To entries - 1
' Get the local name
LocalName = ""
If NetInfo(i).lpLocalName <> 0 Then
LocalName = Space(lstrlen(NetInfo(i).lpLocalName) + 1)
r = lstrcpy(LocalName, NetInfo(i).lpLocalName)
End If ' Strip null character from end
If Len(LocalName) <> 0 Then
LocalName = Left(LocalName, (Len(LocalName) - 1))
End If
If UCase$(LocalName) = UCase$(DriveLetter) Then
' Get the remote name
UNCName = ""
If NetInfo(i).lpRemoteName <> 0 Then
UNCName = Space(lstrlen(NetInfo(i).lpRemoteName) _
+ 1)
r = lstrcpy(UNCName, NetInfo(i).lpRemoteName)
End If ' Strip null character from end
If Len(UNCName) <> 0 Then
UNCName = Left(UNCName, (Len(UNCName) _
- 1))
End If
' Return the UNC path to drive
LetterToUNC = UNCName ' Exit the loop
Exit For
End If
Next i
End If
End If ' End enumeration
nStatus = WNetCloseEnum(hEnum)
End Function

Regards,
Tom Ogilvy
MVP Excel

cm wrote in message <01bf9a41$e3bb06e0$1001...@PT1824.creditfoncier.fr>...