Si préfixe de nom de fichier existe déjà dans dossier
- Messages
- 409
- Excel
- 365, Anglais
- Inscrit
- 07/03/2016
- Emploi
- Entrepreneur en construction
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 (--)
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,
- Messages
- 409
- Excel
- 365, Anglais
- Inscrit
- 07/03/2016
- Emploi
- Entrepreneur en construction
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
- Messages
- 409
- Excel
- 365, Anglais
- Inscrit
- 07/03/2016
- Emploi
- Entrepreneur en construction
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.
- Messages
- 409
- Excel
- 365, Anglais
- Inscrit
- 07/03/2016
- Emploi
- Entrepreneur en construction
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
- Messages
- 409
- Excel
- 365, Anglais
- Inscrit
- 07/03/2016
- Emploi
- Entrepreneur en construction
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
- Messages
- 409
- Excel
- 365, Anglais
- Inscrit
- 07/03/2016
- Emploi
- Entrepreneur en construction
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 ?
- Messages
- 409
- Excel
- 365, Anglais
- Inscrit
- 07/03/2016
- Emploi
- Entrepreneur en construction
pas pour le moment, je vais le tester en remplacebent les variables par le contenu des cbx donne moi quelques intants
- Messages
- 409
- Excel
- 365, Anglais
- Inscrit
- 07/03/2016
- Emploi
- Entrepreneur en construction
Saut 3GB,
après plusieurs tests ca fonctionne super bien!
MERCI BEAUCOUP