Map and Disconnetc Network Drive With Windows API

Option Compare Database
Option Explicit


    Private 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
         
    Private Declare Function WNetCancelConnection2 Lib "mpr.dll" Alias "WNetCancelConnection2A" _
            (ByVal lpName As String, _
             ByVal dwFlags As Long, _
             ByVal fForce As Long) As Long
             
             
    Private 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
   

    Const NO_ERROR = 0
    Const CONNECT_UPDATE_PROFILE = &H1
    Const RESOURCETYPE_DISK = &H1
    Const RESOURCETYPE_PRINT = &H2
    Const RESOURCETYPE_ANY = &H0
    Const RESOURCE_CONNECTED = &H1
    Const RESOURCE_REMEMBERED = &H3
    Const RESOURCE_GLOBALNET = &H2
    Const RESOURCEDISPLAYTYPE_DOMAIN = &H1
    Const RESOURCEDISPLAYTYPE_GENERIC = &H0
    Const RESOURCEDISPLAYTYPE_SERVER = &H2
    Const RESOURCEDISPLAYTYPE_SHARE = &H3
    Const RESOURCEUSAGE_CONNECTABLE = &H1
    Const RESOURCEUSAGE_CONTAINER = &H2

Public Function Disconnect(Drive As String) As Long

        Disconnect = WNetCancelConnection2(Drive, CONNECT_UPDATE_PROFILE, True)
    
End Function

Public Function Connect(Drive As String, UNC As String, User As String, Password As String) As Long
    Dim Disconnected As Long
    Dim Answer
    
    Dim NetR As NETRESOURCE       

    NetR.dwScope = RESOURCE_GLOBALNET
    NetR.dwType = RESOURCETYPE_DISK
    NetR.dwDisplayType = RESOURCEDISPLAYTYPE_SHARE
    NetR.dwUsage = RESOURCEUSAGE_CONNECTABLE
    NetR.lpLocalName = Drive
    NetR.lpRemoteName = UNC

    Connect = WNetAddConnection2(NetR, Password, User, CONNECT_UPDATE_PROFILE)
    
    If Connect = 0 Then
        Exit Function
        ElseIf Connect = 67 Then
            MsgBox UNC & " is either invalid or unavailable!" & vbLf & vbLf & _
                   "Program execution may be affected by this situation", vbCritical, "" & _
                   "Error connecting to " & UNC
            Exit Function
        
        ElseIf Connect = 85 Then
            Disconnected = Disconnect(Drive)
            If Disconnected = 0 Then GoTo ConnectNT

            Answer = MsgBox("Could not map a drive to " & UNC & " due to the " & _
                            "drive letter already being in use." & vbLf & _
                            "Please disconnect the I: drive and try again", _
                             vbRetryCancel + vbCritical, "Error Attempting " & _
                            "to Connect to " & UNC)
            If Answer = vbRetry Then GoTo ConnectNT
        
        ElseIf Connect = 1202 Then
            Disconnected = Disconnect(Drive)
            If Disconnected = 0 Then GoTo ConnectNT
            
        ElseIf Connect = 1326 Then
            Disconnected = Disconnect(Drive)
            If Disconnected = 0 Then GoTo ConnectNT
            Answer = MsgBox("Class NETUSE is hard coded to login as Administrator.  " & _
                            "The error code returned indicates that the Username/" & _
                            "Password" & vbLf & "is incorrect. Most probable cause " & _
                            "is that the Administrator password has been changed", _
                             vbRetryCancel + vbCritical, "Error Attempting to " & _
                            "Connect to " & UNC)
            If Answer = vbRetry Then GoTo ConnectNT
        
        Else
            Disconnected = Disconnect(Drive)
            If Disconnected = 0 Then GoTo ConnectNT
            MsgBox "A critical and Unknown error has occured while trying to attach " & _
                   "to " & UNC & vbLf & vbLf & "The Error Code was: " & _
                    Connect & vbLf & vbLf & "Program execution my be affected by " & _
                   "this situation", vbCritical
            Exit Function
        
        End If
    

End Function