Netzlaufwerke Trennen und Verbinden.

Beispieldatei (TrennenVerbinden.zip 18 kB)
 

Um Netzlaufwerke zu verbinden, kann man die vorliegende Mappe benutzen. Netzwerkpfade in Spalte A werden als Laufwerke mit dem Laufwerksbuchstaben in Spalte B verbunden. In einer Schleife werden alle Pfade ab Zeile 7 verbunden und zwar so lange, bis in Spalte A nichts mehr steht. Netzlaufwerke, deren Buchstabe man in eine Inputbox eingibt, werden getrennt.

Zwei Buttons mit dem Namen cmbTrennen und cmbVerbinden werden im Klassenmodul des Tabellenblattes mit den Laufwerks- und Pfadinformationen benötigt. Hier der Code:

Option Explicit

Private Sub cmbTrennen_Click()
Dim sLW As String
sLW = InputBox("Buchstabe eingeben", "Laufwerksverbindung trennen")
If sLW = "" Then Exit Sub
If VerbindungTrennen(sLW) = True Then
   MsgBox "Verbindung getrennt"
Else
   MsgBox "Verbindung nicht getrennt"
End If
End Sub


Private Sub cmbVerbinden_Click()
Dim sLW As String, sPfad As String
Dim lZeile As Long
lZeile = 7
Do
   sPfad = Cells(lZeile, 1)
   sLW = Cells(lZeile, 2)
   If sPfad = "" Then Exit Do
   If LaufwerksbuchstabeFrei(sLW) = False Then
      Cells(lZeile, 3) = "Buchstabe belegt"
   Else
      If VerbindungHerstellen(sPfad, sLW) Then
         Cells(lZeile, 3) = "Erfolg"
      Else
         Cells(lZeile, 3) = "Kein Erfolg"
      End If
   End If
   lZeile = lZeile + 1
Loop
End Sub

In ein allgemeines Modul:

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 Declare Function GetLogicalDrives _
    Lib "kernel32" () As Long

Private Const CONNECT_UPDATE_PROFILE = &H1
Private Const RESOURCE_GLOBALNET = &H2
Private Const RESOURCETYPE_ANY = &H0
Private Const RESOURCEDISPLAYTYPE_SHARE = &H3
Private Const RESOURCEUSAGE_CONNECTABLE = &H1
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

Sub test()
If LaufwerksbuchstabeFrei("v") = True Then MsgBox "Buchstabe V frei"
If VerbindungHerstellen("\\michael\michael (c)\windows", "v") Then _
   MsgBox "Erfolgreich verbunden"
If VerbindungTrennen("v") Then _
   MsgBox "Erfolgreich getrennt"
End Sub

Public Function VerbindungHerstellen(sNetzlaufwerk As String, _
   sLaufwerksbuchstabe As String) As Boolean
Dim lRück As Long
Dim udtNetres As NETRESOURCE
Dim sUser As String
Dim strPasswort As String
Dim lngDauerhaft As Long
   sLaufwerksbuchstabe = Left(sLaufwerksbuchstabe, 1) & ":"
   With udtNetres
       .dwScope = RESOURCE_GLOBALNET
       .dwType = RESOURCETYPE_ANY
       .dwDisplayType = RESOURCEDISPLAYTYPE_SHARE
       .dwUsage = RESOURCEUSAGE_CONNECTABLE
       .lpRemoteName = sNetzlaufwerk
       .lpLocalName = sLaufwerksbuchstabe
   End With
   sUser = vbNullString
   strPasswort = vbNullString 'default Passwort user, ""=ohne
   lngDauerhaft = CONNECT_UPDATE_PROFILE 'Verbindung _
   auch beim nächsten Start
   'lngDauerhaft = 0 Verbindung nur bis zum nächsten Start
   lRück = WNetAddConnection2(udtNetres, strPasswort, _
   sUser, lngDauerhaft)
   If lRück = 0 Then VerbindungHerstellen = True
End Function

Public Function VerbindungTrennen(sLaufwerksname As String) As Boolean
Dim lRück As Long
   sLaufwerksname = Left(sLaufwerksname, 1) & ":"
   lRück = WNetCancelConnection2(sLaufwerksname, _
      CONNECT_UPDATE_PROFILE, 1)
   If lRück = 0 Then VerbindungTrennen = True
End Function

Public Function LaufwerksbuchstabeFrei( _
   sLaufwerksbuchstabe As String) As Boolean
Dim a As Long, lngLW As Long
sLaufwerksbuchstabe = LCase(Left(sLaufwerksbuchstabe, 1))
LaufwerksbuchstabeFrei = True
lngLW = GetLogicalDrives()
For a = 97 To 123
    If lngLW And 2 ^ (a - 97) Then
        If Chr(a) = sLaufwerksbuchstabe Then _
        LaufwerksbuchstabeFrei = False
    End If
Next
End Function