Launch a network drive

[316johniam]

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]

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]

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]

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