A handy module to connect to and disconnect from network locations.
Module
'Create a Module named ModNetUse
Option Explicit
Public Declare Function WNetAddConnection2 Lib "mpr.dll" Alias "WNetAddConnection2A" _
(lpNetResource As NETRESOURCE, ByVal lpPassword As String, ByVal lpUsername As String, _
ByVal dwFlags As Long) As Long
Public Declare Function WNetCancelConnection2 Lib "mpr.dll" _
Alias "WNetCancelConnection2A" (ByVal lpName As String, ByVal dwFlags As Long, _
ByVal fForce As Long) As Long
Public ErrorNum As Long
Public ErrorMsg As String
Public rc As Long 'Holds the Return Code from a called function
Public RemoteName As String
'Consts for return codes errors
Public Const ERROR_BAD_DEV_TYPE = 66&
Public Const ERROR_ALREADY_ASSIGNED = 85&
Public Const ERROR_ACCESS_DENIED = 5&
Public Const ERROR_BAD_NET_NAME = 67&
Public Const ERROR_BAD_PROFILE = 1206&
Public Const ERROR_BAD_PROVIDER = 1204&
Public Const ERROR_BUSY = 170&
Public Const ERROR_CANCEL_VIOLATION = 173&
Public Const ERROR_CANNOT_OPEN_PROFILE = 1205&
Public Const ERROR_DEVICE_ALREADY_REMEMBERED = 1202&
Public Const ERROR_EXTENDED_ERROR = 1208&
Public Const ERROR_INVALID_PASSWORD = 86&
Public Const ERROR_NO_NET_OR_BAD_PATH = 1203&
Public Const ERROR_NO_NETWORK = 1222&
Public Const ERROR_NO_CONNECTION = 8
Public Const ERROR_NO_DISCONNECT = 9
Public Const ERROR_DEVICE_IN_USE = 2404&
Public Const ERROR_NOT_CONNECTED = 2250&
Public Const ERROR_OPEN_FILES = 2401&
Public Const ERROR_MORE_DATA = 234
Public Const CONNECT_UPDATE_PROFILE = &H1
Public Const RESOURCETYPE_DISK = &H1
Public Type NETRESOURCE
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 lpNetResourse As NETRESOURCE
Public Sub Connect(ByVal HostName As String, ByVal RemoteName As String, ByVal Username As String, ByVal Password As String)
Dim lpUsername As String
Dim lpPassword As String
On Error GoTo Err_Connect
ErrorNum = 0
ErrorMsg = ""
lpNetResourse.dwType = RESOURCETYPE_DISK
lpNetResourse.lpLocalName = RemoteName & Chr(0)
'Drive Letter to use
lpNetResourse.lpRemoteName = "\\" & HostName & Chr(0)
'Network Path to share
lpNetResourse.lpProvider = Chr(0)
lpPassword = Password & Chr(0)
'password on share pass "" if none
lpUsername = Username & Chr(0)
'username to connect as if applicable
rc = WNetAddConnection2(lpNetResourse, lpPassword, lpUsername, CONNECT_UPDATE_PROFILE)
If rc <> 0 Then GoTo Err_Connect
Exit Sub
Err_Connect:
ErrorNum = rc
ErrorMsg = WnetError(rc)
End Sub
Public Sub DisConnect(ByVal Name As String, ByVal ForceOff As Boolean)
On Error GoTo Err_DisConnect
ErrorNum = 0
ErrorMsg = ""
rc = WNetCancelConnection2(Name & Chr(0), CONNECT_UPDATE_PROFILE, ForceOff)
If rc <> 0 Then GoTo Err_DisConnect
Exit Sub
Err_DisConnect:
ErrorNum = rc
ErrorMsg = WnetError(rc)
End Sub
Private Function WnetError(Errcode As Long) As String
Select Case Errcode
Case ERROR_BAD_DEV_TYPE
WnetError = "Bad device."
Case ERROR_ALREADY_ASSIGNED
WnetError = "Already Assigned."
Case ERROR_ACCESS_DENIED
WnetError = "Access Denied."
Case ERROR_BAD_NET_NAME
WnetError = "Bad net name"
Case ERROR_BAD_PROFILE
WnetError = "Bad Profile"
Case ERROR_BAD_PROVIDER
WnetError = "Bad Provider"
Case ERROR_BUSY
WnetError = "Busy"
Case ERROR_CANCEL_VIOLATION
WnetError = "Cancel Violation"
Case ERROR_CANNOT_OPEN_PROFILE
WnetError = "Cannot Open Profile"
Case ERROR_DEVICE_ALREADY_REMEMBERED
WnetError = "Device already remembered"
Case ERROR_EXTENDED_ERROR
WnetError = "Device already remembered"
Case ERROR_INVALID_PASSWORD
WnetError = "Invalid Password"
Case ERROR_NO_NET_OR_BAD_PATH
WnetError = "Could not find the specified device"
Case ERROR_NO_NETWORK
WnetError = "No Network Present"
Case ERROR_DEVICE_IN_USE
WnetError = "Connection Currently in use "
Case ERROR_NOT_CONNECTED
WnetError = "No Connection Present"
Case ERROR_OPEN_FILES
WnetError = "Files open and the force parameter is false"
Case ERROR_MORE_DATA
WnetError = "Buffer to small to hold network name, make lpnLength bigger"
Case Else:
WnetError = "Unrecognized Error " + Str(Errcode) + "."
End Select
End Function
Usage
Private Sub ConnectNetworkDrive()
Call ModNetUse.Connect("Jason\c$", "T:", "defaultsharename", "pass1234")
'Maps the local drive T: to a computer with a host name of Jason
'The username used to connect to Jason is defaultsharename and the password is
'pass1234
If (ModNetUse.rc <> 0) And (ModNetUse.rc <> 85) Then
MsgBox ModNetUse.ErrorMsg
End If
'returns zero if successful otherwise displays error message
End Sub
Private Sub DisconnectMappedDrive()
'Disconnects Drive T:, the True forces whatever is open to close
Call ModNetUse.DisConnect("T:", True)
If (ModNetUse.rc <> 0) And (ModNetUse.rc <> 85) Then
MsgBox ModNetUse.ErrorMsg
End If
End Sub