VBA how to save using unc path instead of mapped drives

[FlatStanley]

Hi

i am writing macros for use on different computers.
we have certain drives mapped but because not everyones drives are called up by the same letter i need to use the UNC file path.

One particular macro has been giving me trouble, I need it to save multiple workbooks using the UNC path
Ex. \\server\volume\folder instead of Z:

It use to be a code with Chdir to accomplish this, however that is only compatible with a drive letter, and I don't know any other way that works without the drive letter.

Any help would be much appreciated, thanks!

 

[Leith Ross]

Hello FlatStanley,

I looked through my files and found this code. It should do what you want. First, add a new module to your VBA project and the paste all of the macro code shown into the module. You can then call the macro LetterToUNC from anywhere in your code. This code will work on operating systems that support 32 bit platforms. If your OS is only 64 bits then let me know. The API calls will need to be changed.

Macro Code

Private Const RESOURCETYPE_ANY      As Long = &H0
Private Const RESOURCE_CONNECTED    As Long = &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, _
         ByRef lpNetResource As Any, _
         ByRef lphEnum As Long) _
    As Long

Private Declare Function WNetEnumResource _
    Lib "mpr.dll" Alias "WNetEnumResourceA" _
        (ByVal hEnum As Long, _
         ByRef lpcCount As Long, _
         ByRef lpBuffer As Any, _
         ByRef lpBufferSize As Long) _
    As Long

Private Declare Function WNetCloseEnum _
    Lib "mpr.dll" _
        (ByVal hEnum As Long) _
    As Long

Private Declare Function lstrlen _
    Lib "kernel32.dll" Alias "lstrlenA" _
        (ByVal lpString As Any) _
    As Long

Private Declare Function lstrcpy _
    Lib "kernel32.dll" Alias "lstrcpyA" _
        (ByVal lpString1 As Any, _
         ByVal lpString2 As Any) _
    As Long

Function LetterToUNC(DriveLetter As String) As String

    Dim hEnum           As Long
    Dim NetInfo(1023)   As NETRESOURCE
    Dim entries         As Long
    Dim i               As Long
    Dim LocalName       As String
    Dim nStatus         As Long
    Dim r               As Long
    Dim UNCName         As String

      ' 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

Macro Example

    Dim UNCpath As String
        
      ' Get the UNC path for the "Z" drive.
        UNCpath = LetterToUNC("Z:")