VÉRIFIER LA CONFORMITÉ DU NOM D'UN FICHIER

Public Function ValideNomFichier(ByVal sNomFichier As String, _
                                 Optional sRemplaceCaractèrePar As String = "-") As String

    ' Cette fonction renvoie un nom de fichier autorisé
    ' On remplace les mauvais caractères par sRemplaceCaractèrePar
    '   (valeur par défaut = signe moins '-')
    ' Les caractères autorisés sont :
    '   A-Z   Lettre               +   Signe plus
    '   0-9   Nombre               ,   Virgule
    '   space   Espace             ;   Point-virgule
    '   '   Apostrophe             =   Signe égal
    '   -   Tiret                  @   Arobase
    '   !   Point d'exclamation   [ ]  Crochets
    '   #   Dièse                  _   Tiret de soulignement
    '   $   Dollar                { }  Accolades
    '   %   Pour cent              ~   Tilde
    '   &   Et commercial          `   Accent
    '  ( )  Parenthèses            .   Point
    ' plus toutes les combinaisons valables des lettres avec accents
    
    ' !! Cette fonction ne fonctionne pas avec des chemins complets
    '    puisque le caractère back-slash '\' n'est pas autorisé
    
    Dim Temp As String, Car As String, r As Long
    
    ' Avant de commencer, on va vérifier que le caractère de remplacement est
    ' lui-même autorisé (ce serait trop bête)
    sRemplaceCaractèrePar = Left(sRemplaceCaractèrePar, 1) ' un seul caractère
    If Not (sRemplaceCaractèrePar Like "[A-Z]" Or _
            sRemplaceCaractèrePar Like "[a-z]" Or _
            sRemplaceCaractèrePar Like "[0-9]" Or _
            sRemplaceCaractèrePar Like "[ '!#$%&()+,;=@{}~`.]" Or _
            sRemplaceCaractèrePar Like "[-]" Or _
            sRemplaceCaractèrePar Like "[[]" Or _
            sRemplaceCaractèrePar Like "[]]" Or _
            sRemplaceCaractèrePar Like "[_]" Or _
            sRemplaceCaractèrePar Like "[àéèêïîôùû]") Then _
                sRemplaceCaractèrePar = "-"  ' Si non autorisé, impose trait d'union
    
    Temp = sNomFichier
    ' Vérifie que chaque caractère est autorisé
    For r = 1 To Len(Temp)
        Car = Mid(Temp, r, 1)
        If Not (Car Like "[A-Z]" Or _
                Car Like "[a-z]" Or _
                Car Like "[0-9]" Or _
                Car Like "[ '!#$%&()+,;=@{}~`.]" Or _
                Car Like "[-]" Or _
                Car Like "[[]" Or _
                Car Like "[]]" Or _
                Car Like "[_]" Or _
                Car Like "[àéèêïîôùû]") Then _
                    Mid(Temp, r, 1) = sRemplaceCaractèrePar
    Next r
    
    ' S'il y a eu plusieurs remplacements à la suite, on va se retrouver avec
    ' plusieurs signes '-' à la queue leuleu : pas joli : On n'en laisse qu'un.
    Do While InStr(1, Temp, sRemplaceCaractèrePar & sRemplaceCaractèrePar) <> 0
        Temp = Replace(Temp, sRemplaceCaractèrePar & sRemplaceCaractèrePar, sRemplaceCaractèrePar)
        DoEvents
    Loop
    
    ' Renvoie le nom modifié
    ValideNomFichier = Temp

End Function

Télécharger le zip