lundi 21 décembre 2015

Vérifier par VBA si un lecteur ou un dossier (répertoire) ou un fichier existe

Cocher la bibliothèque  Microsoft Scripting Runtime dans Outils / Références

Dans un module en VBA, copier/coller le code suivant :

Public oFSO As Scripting.FileSystemObject
Public oFichier As Scripting.File 'pour gérer un fichier
Public oTxt As Scripting.TextStream 'pour gérer le contenu

Function VerifLecteur(Lecteur As String) As Boolean
    'permet de tester l'existence d'un lecteur
    'initialisation de l'objet oFSO
    Set oFSO = New Scripting.FileSystemObject
    'test si le lecteur  existe
    If oFSO.DriveExists(Lecteur) = True Then
        VerifLecteur = True
    Else
        VerifLecteur = False
    End If
End Function

Function VerifRep(Repertoire As String) As Boolean
    'permet de tester l'existence d'un répertoire
    'initialisation de l'objet oFSO
    Set oFSO = New Scripting.FileSystemObject
    'test si le lecteur  existe
    If oFSO.FolderExists(Repertoire) = True Then
        VerifRep = True
    Else
        VerifRep = False
    End If
End Function

Function VerifFich(Fichier As String) As Boolean
    'permet de tester l'existence d'un fichier
    'initialisation de l'objet oFSO
    Set oFSO = New Scripting.FileSystemObject
    'test si le lecteur  existe
    If oFSO.FileExists(Fichier) = True Then
        VerifFich = True
    Else
        VerifFich = False
    End If
End Function


Dans un autre module, faire appel à ces fonctions, par exemple de la manière suivante :

Sub Test()
    'initialisation de l'objet oFSO
    Set oFSO = New Scripting.FileSystemObject
 
    'test sur un lecteur
    If VerifLecteur("P") = True Then
        MsgBox "le lecteur existe"
    Else
        MsgBox "le lecteur n'existe pas"
    End If

    'test sur un dossier (répertoire)
    If VerifRep("C:\Android") = True Then
        MsgBox "le repertoire existe"
    Else
        MsgBox "le repertoire n'existe pas"
    End If
 
    'test sur un fichier
    If VerifFich("C:\Windows\win.ini") = True Then
        MsgBox "le fichier existe"
    Else
        MsgBox "le fichier n'existe pas"
    End If


End Sub