VBA Tipp: Netzlaufwerk verbinden/trennen

Aus DBWiki
Wechseln zu: Navigation, Suche

Problem

Ich möchte per VBA Netzlaufwerke verbinden und wieder trennen. Es gibt 2 Möglichkeiten, dieses Problem zu lösen.

Lösung #1

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
 
Private Declare Function WNetAddConnection2A Lib "mpr" ( _
   lpNetResource As NETRESOURCE, _
   ByVal lpPassword As String, _
   ByVal lpUserName As String, _
   ByVal dwFlags As Long) As Long
 
Private Declare Function WNetCancelConnection2A Lib "mpr" ( _
   ByVal lpName As String, _
   ByVal dwFlags As Long, _
   ByVal fForce As Long) As Long
 
 
' Im Folgenden sind alle für den Bereich NETRESOURCE
' definierten Konstanten gelistet, nicht nur jene, die
' im Beispiel Verwendung finden.
Public Const RESOURCE_CONNECTED           As Long = &H1
Public Const RESOURCE_PUBLICNET           As Long = &H2
Public Const RESOURCE_GLOBALNET           As Long = &H2
Public Const RESOURCE_REMEMBERED          As Long = &H3
Public Const RESOURCE_RECENT              As Long = &H4
Public Const RESOURCE_CONTEXT             As Long = &H5
 
Public Const RESOURCETYPE_ANY             As Long = &H0
Public Const RESOURCETYPE_DISK            As Long = &H1
Public Const RESOURCETYPE_PRINT           As Long = &H2
Public Const RESOURCETYPE_UNKNOWN         As Long = &HFFFFFFFF
 
Public Const RESOURCEUSAGE_CONNECTABLE    As Long = &H1
Public Const RESOURCEUSAGE_CONTAINER      As Long = &H2
Public Const RESOURCEUSAGE_RESERVED       As Long = &H80000000
 
Public Const RESOURCEDISPLAYTYPE_GENERIC  As Long = &H0
Public Const RESOURCEDISPLAYTYPE_DOMAIN   As Long = &H1
Public Const RESOURCEDISPLAYTYPE_SERVER   As Long = &H2
Public Const RESOURCEDISPLAYTYPE_SHARE    As Long = &H3
Public Const RESOURCEDISPLAYTYPE_FILE     As Long = &H4
Public Const RESOURCEDISPLAYTYPE_GROUP    As Long = &H5
 
Public Const CONNECT_UPDATE_PROFILE       As Long = &H1
 
Public Const NO_ERROR                     As Long = 0
Public Const WN_SUCCESS                   As Long = NO_ERROR
 
Public Sub NetzlaufwerkVerbinden(strRemoteName As String, _
                                 Optional strLocalName As String, _
                                 Optional strUser As String, _
                                 Optional strPass As String)
 
   'Quelle: www.dbwiki.net oder www.dbwiki.de
 
   Dim nr As NETRESOURCE
   Dim errInfo As Long
 
   With nr
      .dwScope = RESOURCE_GLOBALNET
      .dwType = RESOURCETYPE_DISK
      .dwDisplayType = RESOURCEDISPLAYTYPE_SHARE
      .dwUsage = RESOURCEUSAGE_CONNECTABLE
      .lpLocalName = strLocalName     'wenn leer, dann ohne Laufwerksbuchstaben verbinden
      .lpRemoteName = strRemoteName   'ein gültiger Freigabename
      '.lpComment = "optional"
      '.lpProvider = ' Freilassen
   End With
   'wenn strUser und strPass leer sind,
   'werden die Informationen dem lokalen Kontext entnommen
   errInfo = WNetAddConnection2A(nr, strPass, strUser, CONNECT_UPDATE_PROFILE)
   If errInfo <> WN_SUCCESS Then _
      MsgBox "Fehler: " & errInfo & " Verbinden nicht erfolgreich!", _
      vbExclamation, "NetzlaufwerkVerbinden"
End Sub
 
Public Sub NetzlaufwerkTrennen(strLocalName As String)
 
   'Quelle: www.dbwiki.net oder www.dbwiki.de
 
   Dim errInfo As Long
   'es können entweder der Name des Netzlaufwerks
   'oder auch sein UNC-Pfad angegeben werden
   'strLocalName = "\\ServerName\ShareName"
   'strLocalName = "X:"
 
   errInfo = WNetCancelConnection2A(strLocalName, CONNECT_UPDATE_PROFILE, False)
   If errInfo <> WN_SUCCESS Then _
      MsgBox "Fehler: " & errInfo & " Trennen nicht erfolgreich!", _
      vbExclamation, "NetzlaufwerkTrennen"
End Sub

Aufruf

Und dann z.B. verbinden mit:

   NetzlaufwerkVerbinden "\\Antares\Kalk","K:","Kalkulation"

und trennen mit:

   NetzlaufwerkTrennen "K:"

Lösung #2

Public Sub MapNetDrive(Drive As String, Share As String, _
                       Domain As String, User As String, _
                       Password As String)
 
   'Anwendung:
   'Call MapNetDrive("Laufwerksbuchstabe", "\\Servername\Freigabename", _
                     "Domänenname", "Username", "Kennwort")
   'Quelle: www.dbwiki.net oder www.dbwiki.de
 
   Call Shell("NET USE " & Drive & ": " & Share & _
            " /USER:" & Domain & "\" & User & " " & Password)
End Sub
 
 
Public Sub UnMapNetDrive(strDrive As String)
 
   'Anwendung:
   'Call UnMapNetDrive("Laufwerksbuchstabe")
   'Quelle: www.dbwiki.net oder www.dbwiki.de
 
   Call Shell("NET USE " & strDrive & ": /DELETE /Y")
 
End Sub

Aufruf

Und dann z.B. verbinden mit:

   Call MapNetDrive("K",\\Antares\Kalk","MeineDomäne","Karl","KarlsGeheimesKennwort")

und trennen mit:

   Call UnMapNetDrive("K")

Weblinks