NetUserMap

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)
end if
end function
Inputs:
For mapping a drive you will need to provide the drive
letter(string) and the UNC(string).

For unmapping a drive you will need to provide the drive
letter(string)

Returns:a LONG will be returned 0 - operation successfull
other Error codes are documented within the code

Assumes: you will need to modify the "username" and
"password" in the Connect function