Trouble Using VBA Code to map a network drive - vba

Question

Trying to map a network drive letter.
Running code shown below.
See the last function, function xxx. That's my driver code. That's the one I am running.
Unmapping works.
Mapping doesn't work.
Always returns false, means that mapping is never succeeding.
User name, password, and path provided seem accurate.
Any ideas?
Here is the code:
Option Explicit
Private Const CONNECT_UPDATE_PROFILE = &H1
Private Const RESOURCE_CONNECTED As Long = &H1&
Private Const RESOURCE_GLOBALNET As Long = &H2&
Private Const RESOURCETYPE_DISK As Long = &H1&
Private Const RESOURCEDISPLAYTYPE_SHARE& = &H3
Private Const RESOURCEUSAGE_CONNECTABLE As Long = &H1&
Private Declare Function WNetCancelConnection2 Lib "mpr.dll" _
Alias "WNetCancelConnection2A" (ByVal lpName As String, ByVal dwFlags As Long, ByVal fForce As Long) As Long
Private Declare Function WNetAddConnection2 Lib "mpr.dll" _
Alias "WNetAddConnection2A" (lpNetResource As NETCONNECT, ByVal lpPassword As String, ByVal lpUserName As String, ByVal dwFlags As Long) As Long
Private Type NETCONNECT
dwScope As Long
dwType As Long
dwDisplayType As Long
dwUsage As Long
lpLocalName As String
lpRemoteName As String
lpComment As String
lpProvider As String
End Type
Public Function MapDrive(LocalDrive As String, _
RemoteDrive As String, Optional Username As String, _
Optional Password As String) As Boolean
' Example:
' MapDrive "Q:", "\\RemoteMachine\RemoteDirectory", "MyLoginName", "MyPassword"
Dim NetR As NETCONNECT
NetR.dwScope = RESOURCE_GLOBALNET
NetR.dwType = RESOURCETYPE_DISK
NetR.dwDisplayType = RESOURCEDISPLAYTYPE_SHARE
NetR.dwUsage = RESOURCEUSAGE_CONNECTABLE
NetR.lpLocalName = Left(LocalDrive, 1) & ":"
NetR.lpRemoteName = RemoteDrive
'Old code:
' MapDrive = (WNetAddConnection2(NetR, Username, Password, _
' CONNECT_UPDATE_PROFILE) = 0)
'Edited this question and updated this code due to good input by poster:
MapDrive = (WNetAddConnection2(NetR, Password, Username, _
CONNECT_UPDATE_PROFILE) = 0)
End Function
Public Function UnMapDrive(DriveLetter As String) As Boolean
Dim NetR As NETCONNECT
With NetR
.dwScope = RESOURCE_GLOBALNET
.dwType = RESOURCETYPE_DISK
.dwDisplayType = RESOURCEDISPLAYTYPE_SHARE
.dwUsage = RESOURCEUSAGE_CONNECTABLE
.lpLocalName = DriveLetter & ":"
.lpRemoteName = ""
End With
ChDrive ("C") ' Ensure that the drive letter to be dropped is not active
UnMapDrive = (WNetCancelConnection2(DriveLetter, CONNECT_UPDATE_PROFILE, True) = 0)
End Function
Here is the driver code:
Public Sub xxx()
Dim retval As String
retval = UnMapDrive("S:")
MsgBox retval
retval = MapDrive("S:", _
"\\AFHOUFILE02\User_Folders", _
"kmistry", "XXXXXX")
MsgBox retval
End Sub

Answer 1

You're passing the user ID and password in the incorrect order. In your definition:
Private Declare Function WNetAddConnection2 Lib "mpr.dll" _
Alias "WNetAddConnection2A" (lpNetResource As NETCONNECT, ByVal lpPassword As String, ByVal lpUserName As String, ByVal dwFlags As Long) As Long
And then in your call:
MapDrive = (WNetAddConnection2(NetR, Username, Password, _
CONNECT_UPDATE_PROFILE) = 0)
Based on the declaration, the password should precede the username.
Also, your unmap routine is doubling-up the colon on the drive, but it apparently must not be affecting the outcome since you said it's working.

Answer 2

I see a couple issues with your code and I think there's an easier, more reliable method of programmatically mapping a drive.
Try this method instead:
Public Function mapDrive(mdDrive As String, mdRoute As String, _
Optional mdUserName As String, Optional mdPassword As String) As Boolean
On Error GoTo catchErr
Dim mdMapRoute As String, WshNet As Object
Set WshNet = CreateObject("WScript.Network")
If mdUserName = "" Then
WshNet.MapNetworkDrive mdDrive, mdMapRoute
Else
If mdPassword = "" Then
WshNet.MapNetworkDrive mdDrive, mdMapRoute, , mdUserName
Else
WshNet.MapNetworkDrive mdDrive, mdMapRoute, , mdUserName, mdPassword
End If
End If
catchErr:
Set WshNet = Nothing
Select Case Err
Case 0
mapDrive = True
Case -2147024811 'Already mapped
mapDrive = True
Case Else
MsgBox "Error #" & Err & ": " & vbLf & Err.Description
mapDrive = False
End Select
End Function
Example Usage:
mapDrive "Q:", "\\server\path\sharename\"
More Information:
SmartBear : MapNetworkDrive Method
Lifewire : Working With the Universal Naming Convention (UNC Path)
ESRI Devnet : Pathnames explained: Absolute, relative, UNC, and URL
Wikipedia : Drive Mapping

Answer 3

I found a pretty good solution online that works well on the mapping.
Having trouble unmapping, BUT for me, mapping is more important than unmapping.
The code I already had before seemed to work well on the unmapping.
The combination of the two, gives you a complete solution, although right now, I am not going to take time to gather all that together...
Here it is, the code that worked very well on mapping. I hope readers benefit from it:
JUST COPY PASTE THIS INTO A NEW MODULE...:
#If Win64 Then
Declare PtrSafe Function WNetCancelConnection2 Lib "mpr.dll" Alias "WNetCancelConnection2A" (ByVal lpName As String, ByVal dwFlags As Long, ByVal fForce As Long) As Long
Declare PtrSafe Function WNetAddConnection2 Lib "mpr.dll" Alias "WNetAddConnection2A" (lpNetResource As NETCONNECT, ByVal lpPassword As String, ByVal lpUserName As String, ByVal dwFlags As Long) As Long
#Else
Declare Function WNetCancelConnection2 Lib "mpr.dll" Alias "WNetCancelConnection2A" (ByVal lpName As String, ByVal dwFlags As Long, ByVal fForce As Long) As Long
Declare Function WNetAddConnection2 Lib "mpr.dll" Alias "WNetAddConnection2A" (lpNetResource As NETCONNECT, ByVal lpPassword As String, ByVal lpUserName As String, ByVal dwFlags As Long) As Long
#End If
Const CONNECT_UPDATE_PROFILE As Long = &H1
Const RESOURCE_CONNECTED As Long = &H1
Const RESOURCE_GLOBALNET As Long = &H2
Const RESOURCETYPE_DISK As Long = &H1
Const RESOURCEDISPLAYTYPE_SHARE As Long = &H3
Const RESOURCEUSAGE_CONNECTABLE As Long = &H1
Type NETCONNECT
dwScope As Long
dwType As Long
dwDisplayType As Long
dwUsage As Long
lpLocalName As String
lpRemoteName As String
lpComment As String
lpProvider As String
End Type
Function MapNetworkDrive(ByVal driveLetter As String, ByVal UNC As String) As Boolean
Dim dl As String * 1
Dim nc As NETCONNECT
dl = UCase$(driveLetter)
nc.dwScope = RESOURCE_GLOBALNET
nc.dwType = RESOURCETYPE_DISK
nc.dwDisplayType = RESOURCEDISPLAYTYPE_SHARE
nc.dwUsage = RESOURCEUSAGE_CONNECTABLE
nc.lpLocalName = driveLetter & ":"
nc.lpRemoteName = UNC
MapNetworkDrive = (WNetAddConnection2(nc, vbNullString, vbNullString, CONNECT_UPDATE_PROFILE))
End Function
Function DisconnectNetworkDrive(driveLetter As String) As Boolean
Dim dl As String * 1
Dim nc As NETCONNECT
nc.dwScope = RESOURCE_GLOBALNET
nc.dwType = RESOURCETYPE_DISK
nc.dwDisplayType = RESOURCEDISPLAYTYPE_SHARE
nc.dwUsage = RESOURCEUSAGE_CONNECTABLE
nc.lpLocalName = driveLetter & ":"
nc.lpRemoteName = vbNullString
DisconnectNetworkDrive = Not (WNetCancelConnection2(dl, CONNECT_UPDATE_PROFILE, False))
End Function