vielleicht geht auch bei Dir damit...
12.10.2009 20:28:17
Tino
Hallo,
habe dies auch mal umsetzen müssen, ich habe folgende Lösung im VB6 Bereich gefunden
und auf Excel etwas umgebaut.
Funktioniert bei mir super und ist 10mal schneller beim verbinden und trennen als die Dos befehle.
Vielleicht funktioniert es ja auch bei Dir oder Du kannst es zum laufen bringen.
Option Explicit
Option Private Module
' Konstantenwert für Fehlerfreiheit:
Private Const NO_ERROR As Long = 0&
' Flags-Wert: Verbindung bei Neustart wieder herstellen
Private Const CONNECT_UPDATE_PROFILE As Long = &H1
' Mögliche Konstante für NETRESOURCE
Private Const RESOURCETYPE_DISK As Long = &H1
Private Const RESOURCETYPE_PRINT As Long = &H2
Private Const RESOURCETYPE_ANY As Long = &H0
Private Const RESOURCE_CONNECTED As Long = &H1
Private Const RESOURCE_REMEMBERED As Long = &H3
Private Const RESOURCE_GLOBALNET As Long = &H2
Private Const RESOURCEDISPLAYTYPE_DOMAIN As Long = &H1
Private Const RESOURCEDISPLAYTYPE_GENERIC As Long = &H0
Private Const RESOURCEDISPLAYTYPE_SERVER As Long = &H2
Private Const RESOURCEDISPLAYTYPE_SHARE As Long = &H3
Private Const RESOURCEUSAGE_CONNECTABLE As Long = &H1
Private Const RESOURCEUSAGE_CONTAINER As Long = &H2
' Netzwerkressourcentyp NETRESOURCE
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
' WNetAddConnection2 stellt Netzlaufwerksverbindungen her
Private Declare Function WNetAddConnection2 _
Lib "mpr.dll" Alias "WNetAddConnection2A" ( _
ByRef lpNetResource As NETRESOURCE, _
ByVal Password As String, _
ByVal UserName As String, _
ByVal Flags As Long _
) As Long
' WNetCancelConnection2 trennt bestehende Netzlaufwerke
Private Declare Function WNetCancelConnection2 _
Lib "mpr.dll" Alias "WNetCancelConnection2A" ( _
ByVal Name As String, _
ByVal Flags As Long, _
ByVal fForce As Long _
) As Long
Public Function MapNetworkDrive2(ByVal UNCPath As String, _
ByVal LocalPath As String, _
Optional ByVal UserName As String, _
Optional ByVal Password As String, _
Optional ByVal Persistent As Boolean _
) As Boolean
Dim NetR As NETRESOURCE
Dim lResult As Long
Dim lPersist As Long
' LocalPath muss ein Buchstabe plus Doppelpunkt sein:
LocalPath = Left$(LocalPath, 1) & ":"
' NETRESOURCE-Struktur belegen:
With NetR
.dwType = RESOURCETYPE_DISK
.lpRemoteName = UNCPath
.lpLocalName = LocalPath
End With
' Persistenz-Parameter berücksichtigen:
If Persistent Then
lPersist = CONNECT_UPDATE_PROFILE
End If
' Pfad als Netzwerklaufwerk einzubinden versuchen
lResult = WNetAddConnection2(NetR, Password, UserName, lPersist)
' Prüfung auf Erfolg anhand des Rückgabewerts:
If lResult = NO_ERROR Then
' Aktion erfolgreich
MapNetworkDrive2 = True
Else
MapNetworkDrive2 = False
End If
End Function
Public Function LWtrennen(ByVal Name As String, _
Optional ByVal Force As Boolean = True, _
Optional ByVal Persistent As Boolean _
) ' As Boolean
Dim lPersist As Long
Dim lResult As Long
' Persistenz-Parameter berücksichtigen:
If Persistent Then
lPersist = CONNECT_UPDATE_PROFILE
End If
' Netzwerkverbindung aufheben:
lResult = WNetCancelConnection2(Name, Persistent, CLng(Force))
' Erfolgsauswertung:
If lResult = NO_ERROR Then
LWtrennen = True
Else
LWtrennen = False
'APIErrorDescription (lResult)
End If
End Function
Public Function LW(Pfad As String, Laufwerk As String, Optional Password As String, Optional UserName As String) As Boolean
Dim UNCPath As String ' UNC-Pfad im Netzwerk
Dim LocalDrive As String ' Lokaler Laufwerksbuchstabe
' Parameter definieren
UNCPath = Pfad
LocalDrive = Laufwerk
' Netzwerklaufwerk einzubinden versuchen
If MapNetworkDrive2(UNCPath, LocalDrive, Password, UserName) Then
' MapNetworkDrive war erfolgreich.
' Erfolg an den Anwender melden
LW = True
Else ' MapNetworkDrive war nicht erfolgreich.
LW = False
End If
End Function
'Beispiel Verwendung **********************************************************************************
Sub Beispiel()
If LW("\\" & "IP", "Laufwerk", "Passwort", "Passwort") = False Then
MsgBox "nicht verbunden"
Else
MsgBox "verbunden"
End If
'und trennen
LWtrennen "K:"
End Sub
Gruß Tino