VÉRIFIER LA CONFORMITÉ DU NOM D'UN FICHIER nom, fichier, conformité, caractère, interdit, Source N°16863

Information sur la source

Catégorie :Fichier / Disque Classé sous : nom, fichier, conformité, caractère, interdit Niveau : Débutant Date de création : 05/10/2003 Date de mise à jour : 05/10/2003 02:40:05 Vu / téléchargé: 5 347 / 151

Auteur : jack

Site perso

Ecrire un message privé

Ce membre participe au partage de revenus publicitaires

Note :

9,00 / 10

1
2
3
4
5
6
7
8
9
10

Commentaire sur cette source (4)

Ajouter un commentaire et/ou une note

Description

Lorsque vous voulez enregistrer un fichier et que le nom est issu d'une variable, par exemple comportant le nom d'une machine, il parait utile de vérifier que tous les caractères qui compose le nom soient autorisés par Windows, sinon, vous risquez d'avoir une erreur que peut-être vous n'avez pas géré.

Pour vérifie le nom d'un fichier, simplement :
Nom = ValideNomFichier(Nom)

Les caractères non autorisés seront remplacés par des traits d'union (par défaut) ou par tout autre caractère si vous utilisez la syntaxe :
Nom = ValideNomFichier(Nom, "@")

Pour l'utiliser, collez ce code dans un module, ou récupérez le module dans le Zip.
C'est tout

Source

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

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

Fichier Zip

Pour les "Membres Club", vous pouvez télécharger directement un fichier contenu dans le zip sans télécharger le zip en entier !

modValideNomFichier.bas 3 081 octets

Télécharger le zip

Sources du même auteur

Toutes les sources de jack

Sources de la même categorie

Toutes les sources de la catégorie Fichier / Disque

Sources en rapport avec celle ci

Commentaires

Commentaire de yan35 le 23/12/2006 12:45:42

Eh Oui, pratique !
Merci de l'avoir écrite cette fonction.
10/10
Commentaire de yan35 le 23/12/2006 15:27:07

Je viens de servir de ta fonction et je la complète avec des caractères autorisés complémentaires, comme suit :
>> sRemplaceCaractèrePar Like "[ '!#$%&()+,;=@{}~`.°]" Or _  ' ajout du °
>> sRemplaceCaractèrePar Like "[àéèêïîôùû]" Or _
   sRemplaceCaractèrePar Like UCase("[àéèêïîôùû]")) Then _   ' ajout de ces caractères en majuscules

>> Car Like "[ '!#$%&()+,;=@{}~`.°]" Or _
>> Car Like "[àéèêïîôùû]" Or _
   Car Like UCase("[àéèêïîôùû]")) Then _

Cordialement.
Commentaire de jack le 23/12/2006 15:41:04 administrateur CS

Merci Yan pour cette amélioration.
Je mettrais à jou après les fêtes.
Commentaire de jack le 21/07/2007 18:54:25 administrateur CS

Dans la même série : http://www.vbfrance.com/codes/VERIFIER-CONFORMITE-ADRESSE-EMAIL_43534.aspx

Ajouter un commentaire

Discussions en rapport avec ce code source

Extraire chaine de caractère d'un fichier pdf par nikal86

chaine de caractère par fabrice2205

Ouvertures de fichiers par Rodolf

Choisir la police d'un fichier txt ! par -=The nul =-

recherche de texte dans un fichier par JoeBiloute

Recherche de texte dans un fichier texte par yoda

Question sur les fichiers ... par Surfurax

Recherche de caractères par jlouis37

Problème Commande PUT ajout 00 par Spylover

Prob avec la commande put qui me rajoute 00 par Spylover