Zurück zur Homepage

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 LongAs Long

Private Declare Function WNetCancelConnection2 _
    
Lib "mpr.dll" Alias "WNetCancelConnection2A" _
    (
ByVal lpName As String, _
    
ByVal dwFlags As Long, _
    
ByVal fForce As LongAs 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 StringAs 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 StringAs 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 StringAs Boolean
Dim 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