Creating UNC paths

In Get a UNC path in Excel, Ross McLean shows us some code for returning a UNC path, given a mapped drive path. Lets use the Windows Script Host Object Model (WSHOM) to do the same thing.

I did something similar in Creating UNC paths from mapped drives, except I only returned the network drive paths. Here we are going to actually take a mapped drive and convert it to a full UNC path.

Get UNC Paths

The following function returns a 2-D string array consisting of drive letter (first element) and UNC path for that drive letter (second element).

Function GetNetworkDrives() As String()

Dim WshNetwork As Object ' WshNetwork
Dim drivesList As Object ' WshCollection
Dim i As Long
Dim tempDrives() As String
Dim numRows As Long

  Set WshNetwork = CreateObject("WScript.Network")
  Set drivesList = WshNetwork.EnumNetworkDrives

  ' number of network drives
  numRows = drivesList.count

  ' resize array
  ReDim tempDrives(1 To numRows / 2, 1 To 2)

  ' loop and grab each drive letter and corresponding UNC path
  For i = 0 To UBound(tempDrives) - 1
    tempDrives(i + 1, 1) = drivesList.item(i * 2)
    tempDrives(i + 1, 2) = drivesList.item((i * 2) + 1)
  Next i

  GetNetworkDrives = tempDrives

End Function

I ran the above code in a networked environment, so I have no idea what will happen if you run it on a standalone PC.

Convert Mapped Drive Path to UNC Path

Here's the function I came up with to take a mapped path and return the UNC path. It calls the above function, then loops through the resulting array until the matching drive letter is found.

Once found, the mapped path is swapped for the corresponding UNC path.

Function GetUNCPath(filePath As String) As String

Dim result() As String
Dim i As Long
Dim driveLetter As String
Dim found As Boolean

  ' check for valid path
  If Len(Dir(filePath)) = 0 Then
    Exit Function
  End If

  ' get drive letter
  driveLetter = Left$(filePath, 2)

  ' get UNC paths
  result = GetNetworkDrives

  ' look for matching drive letter in array
  For i = LBound(result) To UBound(result)
    found = (result(i, 1) = driveLetter)

      If found Then ' swap drive letter for matching UNC path
        GetUNCPath = Replace(filePath, driveLetter, result(i, 2))
        Exit Function
      End If
  Next i

End Function

Sample Usage

Sub TestGetUNCPath()

  Debug.Print GetUNCPath("T:\Company Drive\Custom Files\Company Secrets\")

End Sub