1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
| Private Const RESOURCETYPE_DISK = &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
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 GetLastError Lib "kernel32" () As Long
Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Long) As Long
Private Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000
Private Const LANG_NEUTRAL = &H0
Private Const UserName = "Utilisateur"
Private Const PassWord = "password"
Public Sub ReConnect(RepReseau As String, FailOnError As Boolean)
If RepReseau Like "?:*" Then Exit Sub
Dim Buffer As String
Dim err As Long
Dim nr As NETRESOURCE
nr.dwType = RESOURCETYPE_DISK
nr.lpLocalName = ""
nr.lpRemoteName = RepReseau
nr.lpProvider = vbNullString
err = WNetAddConnection2(nr, PassWord, UserName, 0)
If err <> 0 And FailOnError Then
Buffer = Space(200)
FormatMessage FORMAT_MESSAGE_FROM_SYSTEM, ByVal 0&, err, LANG_NEUTRAL, Buffer, 200, ByVal 0&
MsgBox "Erreur de connexion réseau (" & CStr(err) & ") : """ & Left(Buffer, InStr(Buffer, Chr(0)) - 1) & """"
End
End If
End Sub
Public Sub Disconnect(RepReseau As String)
If RepReseau Like "?:*" Then Exit Sub
Call WNetCancelConnection2(RepReseau, 0, True)
End Sub |
