try a new module;
Option Compare Database
Option Explicit
'declare NetWare APIs
Private Declare Function WNetAddConnection Lib "mpr.dll" Alias "WNetAddConnectionA" _
(ByVal lpszNetPath As String, _
ByVal lpszPassword As String, _
ByVal lpszLocalName As String) As Long
Private Declare Function WNetCancelConnection Lib "mpr.dll" Alias "WNetCancelConnectionA" _
(ByVal lpszName As String, _
ByVal bForce As Long) As Long
'declare NT APIs
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
'NetWare Vars
Const NW_Success = &H0
Const NW_Not_Supported = &H1
Const NW_Net_Error = &H2
Const NW_Bad_Pointer = &H4
Const NW_Bad_NetName = &H32
Const NW_Bad_Password = &H6
Const NW_Bad_Localname = &H33
Const NW_Access_Denied = &H7
Const NW_Out_Of_Memory = &HB
Const NW_Already_Connected = &H34
Private Const ERROR_NO_CONNECTION = 8
Private Const ERROR_NO_DISCONNECT = 9
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
'NT Vars
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
Dim RC As Long
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''
'' Sub to Disconnect mapped drive
''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''
'' Error Codes:
'' 2250 - not disconnected for (some reason)
''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function Disconnect(Drive As String) As Long
'attempt to disconnect NT type connection
Disconnect = WNetCancelConnection2(Drive, CONNECT_UPDATE_PROFILE, False)
'if not worked, attempt to disconnect NetWare type connection
If Disconnect <> 0 Then _
Disconnect = WNetCancelConnection(Drive + Chr(0), 0)
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' Sub to Map network drive
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' Error Codes:
' 0 - Connected
' 67 - bad UNC
' 85 - not connected due to existing connection on specified drive letter
' 1202 - attempt to connect NT on existing NW mapping OR
' - attempt to connect NW on existing NT mapping
' 1219 - server valid, path invalid
' 1326 - invalid username/password OR attempt to connect NT with NW code
' 2202 - ?
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function Connect(Drive As String, UNC As String) As Long
Dim Disconnected As Long
Dim Answer
Dim NetR As NETRESOURCE 'for mapping
NetR.dwScope = RESOURCE_GLOBALNET
NetR.dwType = RESOURCETYPE_DISK
NetR.dwDisplayType = RESOURCEDISPLAYTYPE_SHARE
NetR.dwUsage = RESOURCEUSAGE_CONNECTABLE
NetR.lpLocalName = Drive
NetR.lpRemoteName = UNC
ConnectNW:
'attempt Netware type connection
Connect = WNetAddConnection(UNC & Chr(0), "" & Chr(0), Drive & Chr(0))
If Connect = 0 Then
Exit Function
ElseIf Connect = 85 Then
Disconnected = Disconnect(Drive)
If Disconnected = 0 Then GoTo ConnectNW
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 ConnectNW
ElseIf Connect = 1202 Then
Disconnected = Disconnect(Drive)
If Disconnected = 0 Then GoTo ConnectNW
End If
ConnectNT:
'attempt NT type connection if Netware connection fails
Connect = WNetAddConnection2(NetR, "password", "user name", 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
