PDA

View Full Version : Launch a network drive



316johniam
12-01-2006, 11:26 AM
I'm using Windows XP. I have a password protected drive and I'm trying to put together some code to launch the drive from My Computer and paste the password. Can anyone help? Thanks

Ivan F Moala
12-01-2006, 05:44 PM
There are other ways to do this eg Scripting, But here is a general API method taken from here

http://www.xcelfiles.com/Excel01.html#anchor_47






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 Const ERROR_ACCESS_DENIED = 5&
Private Const ERROR_ALREADY_ASSIGNED = 85&
Private Const ERROR_BAD_DEVICE = 1200&
Private Const ERROR_BAD_NET_NAME = 67&
Private Const ERROR_INVALID_PASSWORD = 86&
Private Const ERROR_INVALID_ADDRESS = 487&
Private Const ERROR_INVALID_PARAMETER = 87
Private Const ERROR_MORE_DATA = 234
Private Const ERROR_UNEXP_NET_ERR = 59&
Private Const ERROR_NOT_CONNECTED = 2250&
Private Const ERROR_NOT_SUPPORTED = 50&
Private Const ERROR_OPEN_FILES = 2401&
Private Const ERROR_NOT_ENOUGH_MEMORY = 8
Private Const NO_ERROR = 0

Private Const WN_ACCESS_DENIED = ERROR_ACCESS_DENIED
Private Const WN_ALREADY_CONNECTED = ERROR_ALREADY_ASSIGNED
Private Const WN_BAD_LOCALNAME = ERROR_BAD_DEVICE
Private Const WN_BAD_NETNAME = ERROR_BAD_NET_NAME
Private Const WN_BAD_PASSWORD = ERROR_INVALID_PASSWORD
Private Const WN_BAD_POINTER = ERROR_INVALID_ADDRESS
Private Const WN_BAD_VALUE = ERROR_INVALID_PARAMETER
Private Const WN_MORE_DATA = ERROR_MORE_DATA
Private Const WN_NET_ERROR = ERROR_UNEXP_NET_ERR
Private Const WN_NOT_CONNECTED = ERROR_NOT_CONNECTED
Private Const WN_NOT_SUPPORTED = ERROR_NOT_SUPPORTED
Private Const WN_OPEN_FILES = ERROR_OPEN_FILES
Private Const WN_OUT_OF_MEMORY = ERROR_NOT_ENOUGH_MEMORY
Private Const WN_SUCCESS = NO_ERROR

Dim blnConnected As Boolean

Sub TestConnect()
'// Routine to connect to a Network drive
'// Inputs: As discribed
Dim strUNCname As String
Dim strPassword As String
Dim strDriveLetter As String
Dim strErrorMsg As String

strUNCname = "\\FBI\risc"
strPassword = "Break"
strDriveLetter = "X:\"

MsgBox MapNetWorkDrive(strUNCname, strPassword, _
strDriveLetter)

'// OK failed let's try manually connecting!?
If Not blnConnected Then Show_NetWorkConn_dialg

End Sub

Sub TestDisConnect()
'// Routine to connect to a Network drive
'// Inputs: As discribed
Dim strPassword As String
Dim strDriveLetter As String
Dim strErrorMsg As String
Dim strReturn As String

strDriveLetter = "X:\"

strReturn = DisconnectNetworkDrive(strDriveLetter & _
Chr(0), 0)

If Len(strReturn) <> 0 Then GoTo Err_DisConnect

Exit Sub
Err_DisConnect:
MsgBox "Error: Trying to disconnect Drive - " & _
strDriveLetter & rc

End Sub

Sub Show_NetWorkConn_dialg()
'// Shows the network connect dialog
'// Win98 - to Map Drive manually
Shell "rundll32 user,wnetconnectdialog"
End Sub

'--------------------------------------------------------
'// StripNulls routine
'--------------------------------------------------------
Private Function StripNulls(s As String) As String
'// We need to truncate the string at the first null
'// character. Nulls act as indicators to end of string.
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

'---------------------------------------
'// MapNetworkDrive routine
'---------------------------------------
Function MapNetWorkDrive( _
UNCname As String, _
Password As String, _
Driveletter As String) As String

Dim lStatus As Long
Dim ErrorMsg As String
Dim strUNCname As String
Dim strPassword As String
Dim strDriveLetter As String

On Local Error GoTo MapNetworkDrive_Err
strUNCname = UNCname
strPassword = Password
strDriveLetter = Driveletter

If Right(strUNCname, 1) <> Chr(0) Then _
strUNCname = strUNCname & Chr(0)
If Right(strPassword, 1) <> Chr(0) Then _
strPassword = strPassword & Chr(0)
If Right(strDriveLetter, 1) <> Chr(0) Then _
strDriveLetter = strDriveLetter & Chr(0)

lStatus = WNetAddConnection(strUNCname, _
strPassword, _
strDriveLetter)

blnConnected = False
Select Case lStatus
Case WN_SUCCESS
ErrorMsg = Driveletter & " successfully mapped!"
blnConnected = True
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(lStatus) & "."
End Select

MapNetWorkDrive = ErrorMsg
MapNetworkDrive_End:
Exit Function

MapNetworkDrive_Err:
MsgBox Err.Description, vbInformation

End Function

'---------------------------------------------
' // DisconnectNetworkDrive routine
'---------------------------------------------
Function DisconnectNetworkDrive(Driveletter As String, _
ForceFileClose As Long) As String

Dim lStatus As Long
Dim strDriveLetter As String
Dim ErrorMsg As String

On Local Error GoTo DisconnectNetworkDrive_Err
strDriveLetter = Driveletter
If Right(strDriveLetter, 1) <> Chr(0) Then _
strDriveLetter = strDriveLetter & Chr(0)
lStatus = WNetCancelConnection(strDriveLetter, _
ForceFileClose)

blnConnected = False
Select Case lStatus
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(lStatus) & "."
End Select

DisconnectNetworkDrive = ErrorMsg
DisconnectNetworkDrive_End:
Exit Function

DisconnectNetworkDrive_Err:
MsgBox Err.Description, vbInformation

End Function

316johniam
01-17-2007, 05:08 PM
As I go into my computer I can see all of my drives. I'm trying to have VBA select a drive (drive is already mapped) and launch. The code above gets errors. Thanks

CCkfm2000
01-18-2007, 05:03 AM
hi,

what you need is a batch file, similar to the following code below.

net use x: /d
net use x: \\festini\coldstore$ /user:glo\coldxp password

then all you do is run the batch file

hope this helps