Tester si un lecteur existe

**vinystic** · 02/12/2008, 00h22

Bonsoir,
J'utilise la fonction ChDrive pour que la boite de dialogue "ouvrir" s'ouvre sur un lecteur réseau précis. Je veux tester au préalable si ce lecteur existe pour ne pas générer une erreur si je ne suis pas connecter au réseau.

Merci

**JackOuYA** · 02/12/2008, 00h28

Bonsoir

tu pourrai utiliser fileSystemObject

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Private Sub Command1_Click()
 MsgBox DisqueExiste("C")
 MsgBox DisqueExiste("I")
 
End Sub
 
Function DisqueExiste(LettreDisque As String)
 Set fso = CreateObject("Scripting.FileSystemObject")
 DisqueExiste = fso.DriveExists(LettreDisque)
 Set fso = Nothing
End Function

**ucfoutu** · 02/12/2008, 09h08

Bonjour,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

MsgBox IIf(Dir("g:\", vbVolume) <> "", "existe", "n'existe pas ou n'est pas prêt")

EDIT :

ce qui donne, avec l'utilisation d'une fonction toto :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Private Sub Command1_Click()
  MsgBox toto("C:\")
  MsgBox toto("F:\")
End Sub
 
Private Function toto(D As String) As Boolean
  toto = IIf(Dir(D, vbVolume) <> "", True, False)
End Function

**ucfoutu** · 02/12/2008, 11h36

Re...

Mais je pense que tu t'intéresseras à ce que fait celà, que je savais bien avoir dans mon fouillis ...

Un projet avec un Bouton de commande nommé Command1 et une listybox nommée List1

Mets-y ce code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
Private Const DRIVE_UNKNOWN = 0
Private Const DRIVE_ABSENT = 1
Private Const DRIVE_REMOVABLE = 2
Private Const DRIVE_FIXED = 3
Private Const DRIVE_REMOTE = 4
Private Const DRIVE_CDROM = 5
Private Const DRIVE_RAMDISK = 6
Private Const ERROR_BAD_DEVICE = 1200&
Private Const ERROR_CONNECTION_UNAVAIL = 1201&
Private Const ERROR_EXTENDED_ERROR = 1208&
Private Const ERROR_MORE_DATA = 234
Private Const ERROR_NOT_SUPPORTED = 50&
Private Const ERROR_NO_NET_OR_BAD_PATH = 1203&
Private Const ERROR_NO_NETWORK = 1222&
Private Const ERROR_NOT_CONNECTED = 2250&
Private Const NO_ERROR = 0
Private Declare Function WNetGetConnection Lib "mpr.dll" Alias "WNetGetConnectionA" (ByVal lpszLocalName As String, _
        ByVal lpszRemoteName As String, cbRemoteName As Long) As Long
Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, _
    ByVal lpBuffer As String) As Long
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Private Sub Command1_Click()
  Dim SAD As String, ST As String
  SAD = CHDSKS
  If SAD <> "" Then
    Do
      ST = Mid$(SAD, 1, InStr(SAD, vbNullChar) - 1)
      SAD = Mid$(SAD, InStr(SAD, vbNullChar) + 1)
      Select Case types(ST)
        Case "amovible", "Local", "CD Rom":
          List1.AddItem ST & "   " & types(ST) & _
          IIf(Dir(ST, vbVolume) <> "", " et prêt", " mais non prêt")
        Case "Réseau":
          List1.AddItem ST & "   réseau"
          List1.AddItem "       UNC Path :  " & GUP(Left$(ST, Len(ST) - 1))
      End Select
    Loop While SAD <> ""
    End If
End Sub
 
 
Private Function GUP(DL As String) As String
  On Local Error GoTo GUPERR
  Dim Msg As String, LR As Long, Nomloc As String, NomLoin As String, NomLoinC As Long
  Nomloc = DL
  NomLoin = String$(255, Chr$(32))
  NomLoinC = Len(NomLoin)
  LR = WNetGetConnection(Nomloc, NomLoin, NomLoinC)
  Select Case LR
    Case ERROR_BAD_DEVICE
      Msg = "Error: Bad Device"
    Case ERROR_CONNECTION_UNAVAIL
      Msg = "Error: Connection Un-Available"
    Case ERROR_EXTENDED_ERROR
      Msg = "Error: Extended Error"
    Case ERROR_MORE_DATA
      Msg = "Error: More Data"
    Case ERROR_NOT_SUPPORTED
       Msg = "Error: Feature not Supported"
    Case ERROR_NO_NET_OR_BAD_PATH
       Msg = "Error: No Network Available or Bad Path"
    Case ERROR_NO_NETWORK
       Msg = "Error: No Network Available"
    Case ERROR_NOT_CONNECTED
       Msg = "Error: Not Connected"
    Case NO_ERROR
  End Select
  If Len(Msg) Then
    MsgBox Msg, vbInformation
  Else
    GUP = Left$(NomLoin, NomLoinC)
  End If
GUPE:
  Exit Function
GUPERR:
  MsgBox Err.Description, vbInformation
  Resume GUPE
End Function
Private Function CHDSKS() As String
    Dim LR As Long, LT As Long, CHDs As String * 255
    LT = Len(CHDs)
    LR = GetLogicalDriveStrings(LT, CHDs)
    CHDSKS = Left(CHDs, LR)
End Function
Private Function types(CHDNM As String) As String
  Dim LR As Long
  Dim CHD As String
  LR = GetDriveType(CHDNM)
  Select Case LR
    Case DRIVE_UNKNOWN
      CHD = "Type inconnu"
    Case DRIVE_ABSENT
      CHD = "N'existe pas"
    Case DRIVE_REMOVABLE
      CHD = "amovible"
    Case DRIVE_FIXED
      CHD = "Local"
    Case DRIVE_REMOTE
      CHD = "Réseau"
    Case DRIVE_CDROM
      CHD = "CD Rom"
    Case DRIVE_RAMDISK
      CHD = "Ram Disk"
  End Select
  types = CHD
End Function

Lance et vois (tu devrais y trouver un peu plus que le bonheur)...