Author  

Language  

Operating Systems  

'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