Hi,

in my office we have a procedure to get the full path of any file, to avoid sending each other links to user-mapped drives
however, the procedure we had it's not working anymore

does anyone have a procedure to that that works in Windows 7 (64bit) & Excel 2010 (32bit) ?

thank you!

here is the procedure I am using now, for your reference (I got it probably here) 

Const VER_PLATFORM_WIN32s = 0          'Win32s on Windows 3.1
Const VER_PLATFORM_WIN32_WINDOWS = 1   'Win32 on Windows 95
Const VER_PLATFORM_WIN32_NT = 2        'Win32 on Windows NT

Type OSVERSIONINFO
   dwOSVersionInfoSize As Long
   dwMajorVersion As Long
   dwMinorVersion As Long
   dwBuildNumber As Long
   dwPlatformId As Long
   szCSDVersion As String * 128
End Type
Private Declare Function GetVersionEx Lib "Kernel32" _
() '   Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long

' Declare for Registry functions

Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003
Const HKEY_PERFORMANCE_DATA = &H80000004
Const HKEY_CURRENT_CONFIG = &H80000005
Const HKEY_DYN_DATA = &H80000006

Private Declare Function RegCloseKey Lib "advapi32.dll" _
() '  (ByVal hKey As Long) As Long

Private Declare Function RegOpenKeyEx Lib "advapi32.dll" _
() '   Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey _
   As String, ByVal ulOptions As Long, ByVal samDesired _
   As Long, phkResult As Long) As Long

Private Declare Function RegQueryValue Lib "advapi32.dll" Alias _
  "RegQueryValueA" (ByVal hKey As Long, ByVal lpSubKey As _
   String, ByVal lpValue As String, lpcbValue As Long) As Long

' Note that if you declare lpData as String, then it is
' necessary to pass it with ByVal
Private Declare Function RegQueryValueEx Lib "advapi32.dll" _
() '  Alias "RegQueryValueExA" (ByVal hKey As Long, _
   ByVal lpValueName As String, ByVal lpReserved As Long, _
   lpType As Long, lpData As Any, lpcbData As Long) As Long

   Private Declare Function RegEnumKey Lib "advapi32.dll" _
() '   Alias "RegEnumKeyA" (ByVal hKey As Long, ByVal dwIndex _
   As Long, ByVal lpName As String, ByVal cbName As Long) _
   As Long

Private Declare Function RegEnumValue Lib "advapi32.dll" _
() '   Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex _
   As Long, ByVal lpValueName As String, lpcbValueName _
   As Long, ByVal lpReserved As Long, lpType As Long, _
   ByVal lpData As String, lpcbData As Long) As Long

Private Declare Function RegOpenKey Lib "advapi32.dll" _
() '  Alias "RegOpenKeyA" (ByVal hKey As Long, _
  ByVal lpSubKey As String, phkResult As Long) As Long

Private Declare Function GetComputerName Lib "Kernel32" _
() '   Alias "GetComputerNameA" (ByVal lpBuffer As String, _
   nSize As Long) As Long

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

'2014-01-14 / B.Agullo / got from the itnernet
Public Function GetUNCNameNT(ByVal pathName As String) As String
' Private function that returns real path name (even with mapped drives) under Windows NT

    Dim hKey As Long
    Dim hKey2 As Long
    Dim exitFlag As Boolean
    Dim i As Double
    Dim ErrCode As Long
    Dim rootKey As String
    Dim key As String
    Dim computerName As String
    Dim lComputerName As Long
    Dim stPath As String
    Dim firstLoop As Boolean
    Dim ret As Boolean

    ' first, verify whether the disk is connected to the network
    If Mid(pathName, 2, 1) = ":" Then
       Dim UNCName As String
       Dim lenUNC As Long

       UNCName = String$(520, 0)
       lenUNC = 520
       ErrCode = WNetGetConnection(left(pathName, 2), UNCName, lenUNC)

       If ErrCode = 0 Then
          UNCName = Trim(left$(UNCName, InStr(UNCName, _
            vbNullChar) - 1))
          GetUNCNameNT = UNCName & Mid(pathName, 3)
          Exit Function
       End If
    End If

    ' else, scan the registry looking for shared resources
    '(NT version)
    computerName = String$(255, 0)
    lComputerName = Len(computerName)
    ErrCode = GetComputerName(computerName, lComputerName)
    If ErrCode <> 1 Then
       GetUNCNameNT = pathName
       Exit Function
    End If

    computerName = Trim(left$(computerName, InStr(computerName, _
       vbNullChar) - 1))
    rootKey = "SYSTEM\CurrentControlSet\Services\LanmanServer\Shares"
    ErrCode = RegOpenKey(HKEY_LOCAL_MACHINE, rootKey, hKey)

    If ErrCode <> 0 Then
       GetUNCNameNT = pathName
       Exit Function
    End If

    firstLoop = True

    Do Until exitFlag
       Dim szValue As String
       Dim szValueName As String
       Dim cchValueName As Long
       Dim dwValueType As Long
       Dim dwValueSize As Long

       szValueName = String(1024, 0)
       cchValueName = Len(szValueName)
       szValue = String$(500, 0)
       dwValueSize = Len(szValue)

       ' loop on "i" to access all shared DLLs
       ' szValueName will receive the key that identifies an element
       ErrCode = RegEnumValue(hKey, i#, szValueName, _
           cchValueName, 0, dwValueType, szValue, dwValueSize)

       If ErrCode <> 0 Then
          If Not firstLoop Then
             exitFlag = True
          Else
             i = -1
             firstLoop = False
          End If
       Else
          stPath = GetPath(szValue)
          If firstLoop Then
             ret = (UCase(stPath) = UCase(pathName))
             stPath = ""
          Else
             ret = (UCase(stPath) = UCase(left$(pathName, _
            Len(stPath))))
             stPath = Mid$(pathName, Len(stPath))
          End If
          If ret Then
             exitFlag = True
             szValueName = left$(szValueName, cchValueName)
             GetUNCNameNT = "\\" & computerName & "\" & _
                szValueName & stPath
          End If
       End If
       i = i + 1
    Loop

    RegCloseKey hKey
    If GetUNCNameNT = "" Then GetUNCNameNT = pathName

End Function

' support routine
Public Function GetPath(st As String) As String
   Dim pos1 As Long, pos2 As Long, pos3 As Long
   Dim stPath As String

   pos1 = InStr(st, "Path")
   If pos1 > 0 Then
      pos2 = InStr(pos1, st, vbNullChar)
      stPath = Mid$(st, pos1, pos2 - pos1)
      pos3 = InStr(stPath, "=")
      If pos3 > 0 Then
         stPath = Mid$(stPath, pos3 + 1)
         GetPath = stPath
      End If
   End If

End Function