'Dieser Source stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.
 
'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source !
 
Option Explicit
 
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
 
 
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
 
Const RESOURCETYPE_DISK = &H1
 
Dim NetzResource As NETRESOURCE
Dim UserName As String
Dim UserPasswort As String

Private Sub Form_Load()
  'R1=Rechnername, C_SYSTEM=Name des zuzuweisenden Laufwerks
  NetzResource.lpRemoteName = "\\R1\I_CSS-WORK"
 
  'z: ist der neue Laufwerksname (gegebenfalls ändern)
  NetzResource.lpLocalName = "z:"
 
  'Username & Passwort (anhängig vom Freigabestatus des LW)
  'Inhalt ist bestenfalls egal
  UserName = "Goetz"
  UserPasswort = "holla"
 
  NetzResource.dwType = RESOURCETYPE_DISK
  Label1.Caption = ""
End Sub

Private Sub Command1_Click()
  Dim Result&
    Result = WNetAddConnection2(NetzResource, UserPasswort, _
                                UserName, 0)
 
    If Result = 0 Then
      Label1.Caption = "Verbunden."
      Drive1.Drive = NetzResource.lpLocalName
      Drive1.Refresh
    Else
      Label1.Caption = "Verbindung nicht möglich."
    End If
End Sub

Private Sub Command2_Click()
  Dim Result&
 
    Result = WNetCancelConnection2(NetzResource.lpLocalName, 0, 0)
    If Result = 0 Then
      Label1.Caption = "Getrennt"
    Else
      Label1.Caption = "Trennung nicht möglich."
    End If
 
    Drive1.Refresh
End Sub