XL 2019 Tester l'existence d'un répertoire avant exécution macro

Salut, de la lecture : Manipulation des fichiers en VBA

Merci.
honte sur moi, j'ai vous posé la question avant d'interroger l'oracle google.

Public Function DossierExiste(MonDossier As String)


If Len(Dir(MonDossier, vbDirectory)) > 0 Then
DossierExiste = True
Else
DossierExiste = False
End If
End Function

Morale de l'histoire.
la solution au dessus laisse la macro en attente trop longtemps.
Je passe par un ping, ça m'a l'air plus rapide.


'https://stackoverflow.com/questions...ess-with-vba-code-and-return-results-in-excel
Public Function GetPingResult(Host) As String
Dim objPing As Object, objStatus As Object
Dim strResult As String
Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}"). _
ExecQuery("Select * from Win32_PingStatus Where Address = '" & Host & "'")

avec un ajout de timeout dans la query, c'est tout bon.
ExecQuery("Select * from Win32_PingStatus Where Timeout = 100 and Address = '" & Host & "'")


For Each objStatus In objPing
Select Case objStatus.StatusCode
Case 0: strResult = "Connected " & objStatus.ProtocolAddress
Case 11001: strResult = "Buffer too small"
Case 11002: strResult = "Destination net unreachable"
Case 11003: strResult = "Destination host unreachable"
Case 11004: strResult = "Destination protocol unreachable"
Case 11005: strResult = "Destination port unreachable"
Case 11006: strResult = "No resources"
Case 11007: strResult = "Bad option"
Case 11008: strResult = "Hardware error"
Case 11009: strResult = "Packet too big"
Case 11010: strResult = "Request timed out"
Case 11011: strResult = "Bad request"
Case 11012: strResult = "Bad route"
Case 11013: strResult = "Time-To-Live (TTL) expired transit"
Case 11014: strResult = "Time-To-Live (TTL) expired reassembly"
Case 11015: strResult = "Parameter problem"
Case 11016: strResult = "Source quench"
Case 11017: strResult = "Option too big"
Case 11018: strResult = "Bad destination"
Case 11032: strResult = "Negotiating IPSEC"
Case 11050: strResult = "General failure"
Case Else: strResult = "Unknown host"
End Select
GetPingResult = strResult
Next
Set objPing = Nothing
End Function



'Exemple d'appel :
Sub EssaiPing()
Dim S As String
S = GetPingResult("192.168.1.104")
If Left(S, 10) = "Connected " Then
MsgBox "Lecteur connecté"
Else
MsgBox "Lecteur non connecté"
End If
End Sub