How can I find the path name of a network drive?

[Johnnie100]

I need to differentiate between when the application is live and in testing and best way to do this at our site is by checking the pathname a particular drive is mapped to - but I don't know how to do this can anyone help?

Basically all I want to know is the pathname of say the p: drive.

Thanks in advance for all help given,

 

[softwarescience]

Hello

It sounds simple but this is a bit of a nightmare to implement.

Following is essentially a bas file, please copy all the text between the ********* markers into one bas file.

*********
Option Explicit

Private Declare Function WNetGetUniversalName Lib "mpr" Alias "WNetGetUniversalNameA" (ByVal lpLocalPath As String, ByVal dwInfoLevel As Long, lpBuffer As Any, lpBufferSize As Long) As Long
Private Declare Function WNetGetConnection Lib "mpr" Alias "WNetGetConnectionA" (ByVal lpLocalName As String, lpRemoteName As Any, lpnLength As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pTo As Any, uFrom As Any, ByVal lSize As Long)
Private Declare Function lstrlenA Lib "kernel32" (ByVal PointerToString As Long) As Long

Private Type REMOTE_NAME_INFO
   lpUniversalName As Long
   lpConnectionName As Long
   lpRemainingPath As Long
End Type

Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long

Private Type OSVERSIONINFO
   dwOSVersionInfoSize As Long
   dwMajorVersion As Long
   dwMinorVersion As Long
   dwBuildNumber As Long
   dwPlatformId As Long
   szCSDVersion As String * 128
End Type

Private Const NO_ERROR = 0
Private Const ERROR_ACCESS_DENIED = 5&

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

Private Const REMOTE_NAME_INFO_LEVEL = &H2

Private Const VER_PLATFORM_WIN32s = 0
Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Private Const VER_PLATFORM_WIN32_NT = 2

Public Function GetUncName(ByVal FileSpec As String) As String
Dim Buffer() As Byte
Dim nRet As Long
Dim BufferLen As Long
Dim rni As REMOTE_NAME_INFO
Dim i As Long
   
' make sure we actually have what looks like a drive-based spec
On Error Resume Next
   
If Asc(UCase(Left(FileSpec, 1))) < Asc(&quot;A&quot;) Then
   Exit Function
ElseIf Asc(UCase(Left(FileSpec, 1))) > Asc(&quot;Z&quot;) Then
   Exit Function
ElseIf Mid(FileSpec, 2, 1) <> &quot;:&quot; Then
   Exit Function
End If
   
If Err.Number Then Exit Function
   
On Error GoTo 0
   
If IsWin95 Then
   ReDim Buffer(1 To 260) As Byte
   nRet = WNetGetConnection(Left$(FileSpec, 2), Buffer(1), UBound(Buffer))
   If nRet = NO_ERROR Then
      ' Success! Obtained the universal name for the share
      GetUncName = TrimNull(StrConv(Buffer, vbUnicode)) & Mid$(FileSpec, 3)
      Exit Function
   End If
Else
   ' in NT/98, call it once to get required size of structure
   nRet = WNetGetUniversalName(FileSpec, REMOTE_NAME_INFO_LEVEL, vbNullString, BufferLen)
End If

Select Case nRet
Case ERROR_MORE_DATA    'this can only occur for OS > 95
   ' resize buffer and call again
   ReDim Buffer(0 To BufferLen - 1) As Byte
   nRet = WNetGetUniversalName(FileSpec, REMOTE_NAME_INFO_LEVEL, Buffer(0), BufferLen)
   ' extract UNC name from buffer
   If nRet = NO_ERROR Then
      ' retrieve pointers to each of the returned strings
      rni.lpUniversalName = PointerToDWord(VarPtr(Buffer(0)))
      rni.lpConnectionName = PointerToDWord(VarPtr(Buffer(4)))
      rni.lpRemainingPath = PointerToDWord(VarPtr(Buffer(8)))
      ' extract and return lpUniversalName
      GetUncName = PointerToStringA(rni.lpUniversalName)
   End If
Case ERROR_NOT_CONNECTED    'local file
   GetUncName = FileSpec
Case Else   ' bad path or network down
   GetUncName = &quot;&quot;
End Select
   
End Function
Private Function PointerToStringA(lpStringA As Long) As String
Dim Buffer() As Byte
Dim nLen As Long

If lpStringA Then
   nLen = lstrlenA(ByVal lpStringA)
   
   If nLen Then
      ReDim Buffer(0 To (nLen - 1)) As Byte
      
      Call CopyMemory(Buffer(0), ByVal lpStringA, nLen)
      
      PointerToStringA = StrConv(Buffer, vbUnicode)
   End If
End If

End Function

Private Function PointerToDWord(ByVal lpDWord As Long) As Long
   
Call CopyMemory(PointerToDWord, ByVal lpDWord, 4)

End Function

Private Function TrimNull(ByVal StrIn As String) As String
Dim nul As Long

nul = InStr(StrIn, vbNullChar)
Select Case nul
Case Is > 1
   TrimNull = Left(StrIn, nul - 1)
Case 1
   TrimNull = &quot;&quot;
Case 0
   TrimNull = Trim(StrIn)
End Select

End Function
Public Function IsWin95() As Boolean

Static os As OSVERSIONINFO
Static bRet As Boolean

' just do this once, for optimization
If os.dwPlatformId = 0 Then
   os.dwOSVersionInfoSize = Len(os)
   
   Call GetVersionEx(os)
   
   bRet = (os.dwMinorVersion < 10) And (os.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS)
End If
IsWin95 = bRet

End Function
*********

Then you can call GetUncName("P:&quot to indicate the UNC name of a mapped drive.


Hope this helps

 

[JustinEzequiel]

[tt]Sub main()
Dim oFSO
Dim oDrive

Set oFSO = CreateObject("Scripting.FileSystemObject&quot
Set oDrive = oFSO.GetDrive("Z:&quot
Set oFSO = Nothing

With oDrive
' what you need
Debug.Print "ShareName", .ShareName

' other properties
Debug.Print .AvailableSpace
Debug.Print .DriveLetter
Debug.Print .DriveType
Debug.Print .FileSystem
Debug.Print .FreeSpace
Debug.Print .IsReady
Debug.Print .Path
Debug.Print .RootFolder
Debug.Print .SerialNumber
Debug.Print .TotalSize
Debug.Print .VolumeName
End With
Set oDrive = Nothing
End Sub[/tt]

 

[strongm]

Can I just check whether there is anyone out there who still thinks the FileSystemObject can be ignored?