map to a network drive using VB

[wajahath]

In a VB application i need to map to a network drive, to a new drive which has not been mapped to my computer.

How Can i do this in VB? (Map a drive to my system )

Regards
Wajahath

[cksiow]

check vbNetwork class on http://vblib.virtualave.net


HTH

cksiow
http://vblib.virtualave.net - share our codes

[John G Duffy]

Here is a sample
Start a new project.
Add two command buttons
add two textboxes
Add a module
Paste this code

'
' Goes into the Form
'
option Explicit

private Sub Command1_Click()
Dim lRet
lRet = MapNetworkDrive(Text1, "ABC", Text2, "Sorry")
End Sub

private Sub Command2_Click()
DisconnectNetworkDrive Text2, 1, "Sorry"
End Sub

private Sub Form_Load()
Command1.Caption = "Connect Drive"
Command2.Caption = "Release Drive"
Text1.Text = "\\LAPTOP\C DRIVE"
Text2.Text = "G:"
End Sub
'
' following goes into the module
'
option Explicit

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 WNetGetConnection Lib "mpr.dll" Alias _
"WNetGetConnectionA" (byval lpszLocalName as string, byval _
lpszRemoteName as string, cbRemoteName as Long) as Long

private Declare Function WNetCancelConnection Lib "mpr.dll" Alias _
"WNetCancelConnectionA" (byval lpszName as string, byval bForce as _
Long) as Long

private Declare Function GetUserName Lib "advapi32.dll" Alias _
"GetUserNameA" (byval lpBuffer as string, nSize as Long) as Long

private Const WN_ACCESS_DENIED = 5& 'ERROR_ACCESS_DENIED
private Const WN_ALREADY_CONNECTED = 85& 'ERROR_ALREADY_ASSIGNED
private Const WN_BAD_LOCALNAME = 1200& 'ERROR_BAD_DEVICE
private Const WN_BAD_NETNAME = 67& 'ERROR_BAD_NET_NAME
private Const WN_BAD_PASSWORD = 86& 'ERROR_INVALID_PASSWORD
private Const WN_BAD_POINTER = 487& 'ERROR_INVALID_ADDRESS
private Const WN_BAD_VALUE = 87 'ERROR_INVALID_PARAMETER
private Const WN_MORE_DATA = 234 'ERROR_MORE_DATA
private Const WN_NET_ERROR = 59& 'ERROR_UNEXP_NET_ERR
private Const WN_NOT_CONNECTED = 2250 'ERROR_NOT_CONNECTED
private Const WN_NOT_SUPPORTED = 50& 'ERROR_NOT_SUPPORTED
private Const WN_OPEN_FILES = 2401& 'ERROR_OPEN_FILES
private Const WN_OUT_OF_MEMORY = 8 'ERROR_NOT_ENOUGH_MEMORY
private Const WN_SUCCESS = 0 'NO_ERROR




Function GetUNCPath(DriveLetter as string, DrivePath, ErrorMsg as _
string) as Long

on Local error GoTo GetUNCPath_Err
Dim status as Long
Dim lpszLocalName as string
Dim lpszRemoteName as string
Dim cbRemoteName as Long
lpszLocalName = DriveLetter
If Right$(lpszLocalName, 1) <> Chr$(0) then lpszLocalName = _
lpszLocalName & Chr$(0)
lpszRemoteName = string$(255, Chr$(32))
cbRemoteName = len(lpszRemoteName)
status = WNetGetConnection(lpszLocalName, lpszRemoteName, cbRemoteName)

GetUNCPath = status

Select Case status
Case WN_SUCCESS
ErrorMsg = "Function Performed successfully"
Case WN_NOT_SUPPORTED
ErrorMsg = "This function is not supported"
Case WN_OUT_OF_MEMORY
ErrorMsg = "The System is Out of Memory."
Case WN_NET_ERROR
ErrorMsg = "An error occurred on the network"
Case WN_BAD_POINTER
ErrorMsg = "The network path is invalid"
Case WN_BAD_VALUE
ErrorMsg = "Invalid local device name"
Case WN_NOT_CONNECTED
ErrorMsg = "The drive is not connected"
Case WN_MORE_DATA
ErrorMsg = "The buffer was too small to return the fileservice name"
Case else
ErrorMsg = "Unrecognized error - " & Str$(status) & "."
End Select
If len(ErrorMsg) then
DrivePath = ""
else
' Trim it, and remove any nulls
DrivePath = StripNulls(lpszRemoteName)
End If
Exit Function

GetUNCPath_Err:
MsgBox Err.Description, vbInformation
End Function

Function sGetUserName() as string

Dim lpBuffer as string * 255
Dim lRet as Long
lRet = GetUserName(lpBuffer, 255)
sGetUserName = StripNulls(lpBuffer)
End Function

private Function StripNulls(s as string) as string

'Truncates string at first null character, any text after first null is lost
Dim I as Integer
StripNulls = s
If len(s) then
I = InStr(s, Chr$(0))
If I then StripNulls = Left$(s, I - 1)
End If
End Function


Function MapNetworkDrive(UNCname as string, _
Password as string, _
DriveLetter as string, _
ErrorMsg as string) as Long

Dim status as Long
Dim tUNCname as string, tPassword as string, tDriveLetter as string
on Local error GoTo MapNetworkDrive_Err
tUNCname = UNCname
tPassword = Password
tDriveLetter = DriveLetter
If Right$(tUNCname, 1) <> Chr$(0) then tUNCname = tUNCname & Chr$(0)
If Right$(tPassword, 1) <> Chr$(0) then tPassword = tPassword & Chr$(0)
If Right$(tDriveLetter, 1) <> Chr$(0) then tDriveLetter = tDriveLetter & Chr$(0)
status = WNetAddConnection(tUNCname, tPassword, tDriveLetter)

Select Case status
Case WN_SUCCESS
ErrorMsg = ""
Case WN_NOT_SUPPORTED
ErrorMsg = "Function is not supported."
Case WN_OUT_OF_MEMORY:
ErrorMsg = "The system is out of memory."
Case WN_NET_ERROR
ErrorMsg = "An error occurred on the network."
Case WN_BAD_POINTER
ErrorMsg = "The network path is invalid."
Case WN_BAD_NETNAME
ErrorMsg = "Invalid network resource name."
Case WN_BAD_PASSWORD
ErrorMsg = "The password is invalid."
Case WN_BAD_LOCALNAME
ErrorMsg = "The local device name is invalid."
Case WN_ACCESS_DENIED
ErrorMsg = "A security violation occurred."
Case WN_ALREADY_CONNECTED
ErrorMsg = "This drive letter is already connected to a network drive."
Case else
ErrorMsg = "Unrecognized error - " & Str$(status) & "."
End Select


MapNetworkDrive = status
MapNetworkDrive_End:
Exit Function
MapNetworkDrive_Err:
MsgBox Err.Description, vbInformation
resume MapNetworkDrive_End
End Function



Function DisconnectNetworkDrive(DriveLetter as string, _
ForceFileClose as Long, _
ErrorMsg as string) as Long

Dim status as Long
Dim tDriveLetter as string
on Local error GoTo DisconnectNetworkDrive_Err
tDriveLetter = DriveLetter
If Right$(tDriveLetter, 1) <> Chr$(0) then tDriveLetter = tDriveLetter & Chr$(0)
status = WNetCancelConnection(tDriveLetter, ForceFileClose)
Select Case status
Case WN_SUCCESS
ErrorMsg = ""
Case WN_BAD_POINTER:
ErrorMsg = "The network path is invalid."
Case WN_BAD_VALUE
ErrorMsg = "Invalid local device name"
Case WN_NET_ERROR:
ErrorMsg = "An error occurred on the network."
Case WN_NOT_CONNECTED
ErrorMsg = "The drive is not connected"
Case WN_NOT_SUPPORTED
ErrorMsg = "This function is not supported"
Case WN_OPEN_FILES
ErrorMsg = "Files are in use on this service. Drive was not disconnected."
Case WN_OUT_OF_MEMORY:
ErrorMsg = "The System is Out of Memory"
Case else:
ErrorMsg = "Unrecognized error - " & Str$(status) & "."
End Select


DisconnectNetworkDrive = status
Exit Function
DisconnectNetworkDrive_Err:
MsgBox Err.Description, vbInformation
End Function



'
Run the program. Enter your network drive address ito texzt1
enter your desired Drive letter into text2. then click "Connect Drive" to connect. Return code = 0 if connection established else nonzero
Click "Disconnect Drive" to get rid of connection.

John G