Si préfixe de nom de fichier existe déjà dans dossier

Salut Forum!!

J'ai un petit code ici qui écrase un(les) fichiers déjà existants dans un dossier

j'aimerais ajouter une autre condition:

lorsque je traite les fichiers dans le dossier j'y ajoute 2 petits tirets en avant (--)

image

J'aimerais que le code puisse aussi testé si le fichier existe déjà avec ce préfixe, si le fichier existe déjà: sauter au prochain fichier

Private Sub CommandButton_Validation_Click()

    'Déclaration des variables
    Dim i As Byte

    'Enregistrement de chaque PJ sélectionné
    For i = 0 To ListBox_PJ.ListCount - 1
        If ListBox_PJ.Selected(i) = True Then
            If Not Len(Dir(path & Annee & "\" & Mois & "\" & ListBox_PJ.List(i), vbDirectory)) > 0 Then
                meMail.Attachments(ListBox_PJ.List(i)).SaveAsFile (path & Me.CbxAnnee.Value & "\" & Me.CbxMois.Value & "\" & ListBox_PJ.List(i))
            Else
                Kill path & Annee & "\" & Mois & "\" & ListBox_PJ.List(i)
                meMail.Attachments(ListBox_PJ.List(i)).SaveAsFile (path & Me.CbxAnnee.Value & "\" & Me.CbxMois.Value & "\" & ListBox_PJ.List(i))
            End If
        End If
    Next i

    'Fermeture de l'USF
    Unload Me

End Sub

Merci!

Bonjour Crackwood,

Voici une proposition d'adaptation :

Private Sub CommandButton_Validation_Click()
Dim i As Byte, bChecked as boolean, NormalFullPath as string, CheckedFullPath as string

    'Enregistrement de chaque PJ sélectionné
    For i = 0 To ListBox_PJ.ListCount - 1
        If ListBox_PJ.Selected(i) = True Then
            bChecked = false
            NormalFullPath = path & Annee & "\" & Mois & "\" & ListBox_PJ.List(i)
            CheckedFullPath = path & Annee & "\" & Mois & "\--" & ListBox_PJ.List(i)
            select case true
                case dir(CheckedFullPath) <> "": bChecked = true 'si -- existe, on ne fait rien
                case dir(NormalFullPath) <> "": Kill NormalFullPath 'si fichier normal sans préfixe, on le kill
            end select
            if not bChecked then meMail.Attachments(ListBox_PJ.List(i)).SaveAsFile NormalFullPath 'si -- n'existe pas, on crée le fichier
        End If
    Next i

    'Fermeture de l'USF
    Unload Me

End Sub

Il faudra être vigilant à bien utiliser les variables path et surtout annee et mois qui remplacent les valeurs des cbx.

Cdlt,

Bonjour 3GB,

merci beaucoup pour ton aide

pour l'instant j'ai quelque chose du genre .. mais je ne suis pas certain que tout fonctionne car ca créer quand même le fichier

et si j'enleve le "NOT" avant le "LEN.." dans la premier test du coup le code me dit qu'il ne peut pas kill quelque chose qui ne trouve pas .. ce qui est bien normal

je pourrais y ajouter un On Error Resume Next mais j'aimerais mieux pas ..

vois-tu une option dans mon code

Private Sub CommandButton_Validation_Click()

    'Déclaration des variables
    Dim i As Byte
    Dim strFichier As String

    'Enregistrement de chaque PJ sélectionné
    For i = 0 To ListBox_PJ.ListCount - 1
          If ListBox_PJ.Selected(i) = True Then strFichier = Dir(path & Annee & "\" & Mois & "\" & ListBox_PJ.List(i), vbDirectory)
         If Not Len(strFichier) > 0 And Not Left(strFichier, 2) = "--" Then
                meMail.Attachments(ListBox_PJ.List(i)).SaveAsFile (path & Me.CbxAnnee.Value & "\" & Me.CbxMois.Value & "\" & ListBox_PJ.List(i))
            Else
                Kill path & Annee & "\" & Mois & "\" & ListBox_PJ.List(i)
                meMail.Attachments(ListBox_PJ.List(i)).SaveAsFile (path & Me.CbxAnnee.Value & "\" & Me.CbxMois.Value & "\" & ListBox_PJ.List(i))
            End If
            Next i

    'Fermeture de l'USF
    Unload Me

End Sub

j'aimerais mieux ne pas avoir à remplacer les valeurs des cbx car au niveau de la comptabilité, parfois on recois des courriels au début d'un mois dont le fichier devrait alller dans la comptabilité du mois prédédent ex: des relevés de compte du mois précédent ..

donc j'aime bien avoir la liberté de pouvoir choisir mon mois au fur et à mesure au besoin

Il faudrait que j'en sache un peu plus mais là, j'imagine une listbox avec des éléments comme ceux-ci :

Facture...bla1.pdf

Facture...bla2.pdf

J'imagine une arbo dossier\annee\mois\ d'où sont tirés les éléments de la listbox.

J'imagine aussi que Annee et Mois sont des variables avec une portée sur l'Userform au moins et qu'elles sont bien cadrées (si possible peu changeantes).

Du coup, je teste l'existence du fichier ListBox_PJ.List(i) par exemple au sein de l'arborescence citée plus haut en veillant bien à retirer l'argument vbdirectory ou à le remplacer par vbnormal pour éviter d'avoir des valeurs "." et "..".

C'est à vérifier mais je pense que c'est la fonction Dir qui n'est pas bien utilisée ici.

j'aimerais mieux ne pas avoir à remplacer les valeurs des cbx car au niveau de la comptabilité, parfois on recois des courriels au début d'un mois dont le fichier devrait alller dans la comptabilité du mois prédédent ex: des relevés de compte du mois précédent ..

Ok, du coup, dans un souci de cohérence, il faudrait probablement remplacer Annee et Mois par Me.CbxAnnee.Value et Me.CbxMois.Value ? Sinon, ça va peut-être créer de mauvais tests.

image
Option Explicit

'Déclaration des constantes publiques
Const path As String = "D:\Partage OneDrive\OneDrive - Construction Rénovation Flix\Comptabilité\"

'Déclaration des variables publiques
Dim meMail As Variant
Dim Annee As Integer
Dim Mois As String

Private Sub CbxMois_Change()

End Sub

Private Sub CommandButton_Validation_Click()

    'Déclaration des variables
    Dim i As Byte
    Dim strFichier As String

    'Enregistrement de chaque PJ sélectionné
    For i = 0 To ListBox_PJ.ListCount - 1
          If ListBox_PJ.Selected(i) = True Then strFichier = Dir(path & Annee & "\" & Mois & "\" & ListBox_PJ.List(i), vbDirectory)
         If Not Len(strFichier) > 0 And Not Left(strFichier, 2) = "--" Then
                meMail.Attachments(ListBox_PJ.List(i)).SaveAsFile (path & Me.CbxAnnee.Value & "\" & Me.CbxMois.Value & "\" & ListBox_PJ.List(i))
            Else
                Kill path & Annee & "\" & Mois & "\" & ListBox_PJ.List(i)
                meMail.Attachments(ListBox_PJ.List(i)).SaveAsFile (path & Me.CbxAnnee.Value & "\" & Me.CbxMois.Value & "\" & ListBox_PJ.List(i))
            End If
            Next i

    'Fermeture de l'USF
    Unload Me

End Sub

Private Sub SpinUP_Click()
Me.CbxMois.ListIndex = Me.CbxMois.ListIndex - 1
If Me.CbxMois.Value = "" Then Me.CbxMois.ListIndex = 0
End Sub
Private Sub SpinDOWN_Click()
On Error Resume Next
Me.CbxMois.ListIndex = Me.CbxMois.ListIndex + 1
If Me.CbxMois.Value = "" Then Me.CbxMois.ListIndex = 11
End Sub
Private Sub Userform_Initialize()

    'Déclaration des variables
    Dim Atmt As Variant, r As Byte

    'Attribution de l'email à traiter à la variable objet meMail
    Set meMail = Application.ActiveExplorer.selection.Item(1)

    'Récupération des variables mois et année de récéption du mail
    Mois = Choose(Month(meMail.CreationTime), "01-Janvier", "02-Février", "03-Mars", "04-Avril", "05-Mai", "06-Juin", "07-Juillet", "08-Août", "09-Septembre", "10-Octobre", "11-Novembre", "12-Décembre")
    Annee = Year(meMail.CreationTime)

    'Création des dossier année et mois si inexistant
    If Not Len(Dir(path & Annee, vbDirectory)) > 0 Then MkDir (path & Annee & "\")
    If Not Len(Dir(path & Annee & "\" & Mois, vbDirectory)) > 0 Then MkDir (path & Annee & "\" & Mois & "\")

    'Récupération de toutes les pièces jointes

    On Error GoTo fin
    For Each Atmt In meMail.Attachments
    If Me.CheckBox1.Value = False Then If Not Atmt.fileName Like "*image*" And Not Atmt.fileName Like "*.gif" And Not Atmt.fileName Like "*.htm*" And Not Atmt.fileName Like "*.txt" Then ListBox_PJ.AddItem Atmt.fileName
                 Next Atmt

        'Sélection automatique de tous les pièces jointes
     For r = 0 To ListBox_PJ.ListCount - 1
ListBox_PJ.Selected(r) = True
 Next r

 With CbxAnnee

    .AddItem Annee - 1
    .AddItem Annee
    .AddItem Annee + 1

End With

    With CbxMois

    .AddItem "01-Janvier"
    .AddItem "02-Février"
    .AddItem "03-Mars"
    .AddItem "04-Avril"
    .AddItem "05-Mai"
    .AddItem "06-Juin"
    .AddItem "07-Juillet"
    .AddItem "08-Août"
    .AddItem "09-Septembre"
    .AddItem "10-Octobre"
    .AddItem "11-Novembre"
    .AddItem "12-Décembre"

    End With

Me.CbxAnnee.Value = Annee
Me.CbxMois.Value = Mois

fin:
End Sub

Private Sub Userform_terminate()

    'Vide la variable objet -> Allège la mémoire
    Set meMail = Nothing

End Sub

C'est un formulaire que j'ai crée ici avec un autre utilisateur.

Au niveau de la comptabilité, j'enregistre les pièces jointes du courriel dans un dossier créer automatiquement en fonction du mois de la cbx .. valeur du cbx générée automatiquement à partir de la date du courriel.

Ensuite quand j'entre la facture dans mon logiciel de facturation j'indique -- sur le fichier pour marqué comme traité.

par contre parfois je "télécharge" une facture déjà traitée .. ce qui occasionne des pertes de temps quand je me rends compte que j'ai déjà traitée celle-ci .. j'aimerais juste pouvoir tester si la facture avec préfixe existe déjà dans le dossier

Ok, du coup, dans un souci de cohérence, il faudrait probablement remplacer Annee et Mois par Me.CbxAnnee.Value et Me.CbxMois.Value ? Sinon, ça va peut-être créer de mauvais tests.

Oui affirmatif, bien vu

Ok, c'est clair. Du coup, as-tu testé le code que j'ai posté sans le modifier ?

pas pour le moment, je vais le tester en remplacebent les variables par le contenu des cbx donne moi quelques intants

Saut 3GB,

après plusieurs tests ca fonctionne super bien!

MERCI BEAUCOUP

Rechercher des sujets similaires à "prefixe nom fichier existe deja dossier"