Comment éviter les doublons de fichiers au format date

Résolu

Blackjack23 -
Blackjack23 - 14 déc. 2015 à 19:24

Bonjour, j’ai un souci lorsque j’enregistre mes fichiers « Xlsm » car je ne peux pas vérifier s’ils existent déjà dans le répertoire de destination à cause de leur format, je m’explique :
Mes fichier sont enregistrés au format suivant « numéro de série + date du jour » >> ex : 888881_dd_mm_yyyy
Si j’enregistre mon fichier aujourd’hui et le même le même jour, pas de problème, j’ai bien une boite de dialogue qui s’affiche pour me dire : « le fichier existe déjà, voulez vous le remplacer »
Si j’enregistre mon fichier un jour plus tard avec le même numéro de série, je me retrouve avec deux fois le même fichier « 888881 » mais avec deux dates différentes
Quel code pourrait me permettre de remplacer le fichier identique enregistré quelques jours plus tôt en allant lire que le numéro de série « 888881 ».
Voici le code me permettant d’enregistrer mes fichiers dont le nom est égal au nom se trouvant dans une cellule (Cellule N11 du fichier à enregistrer) mais ne me permettant pas de vérifier si les numéros de série sont identiques.

Sub Save_classeur()

Dim chemin, nom As String

'le chemin pour ouvrir le bon répertoire en allant chercher le numéro du répertoire se trouvant dans la cellule N8 du fichier à enregistrer

chemin = "C:\Documents and Settings\toto\Mes documents\dossier import test\" & Range("N8").Value & "\"

'le nom du fichier sera enregistré sous le nom indiqué dans la cellule N11 (n° de série)

nom = Range("N11").Value

‘Lancement de l’enregistrement au format Xlsm
'ActiveWorkbook.SaveAs Filename:=chemin & nom & Format(Now(), "_dd_mm_yyyy") & ".xlsm", FileFormat:=xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False

End Sub

En espérant avoir été suffisamment clair dans mes explications

Merci

A voir également:

Comment éviter les doublons de fichiers au format date
Format epub - Guide
Format factory - Télécharger - Conversion & Codecs
Format dat - Guide
Hp usb disk storage format tool - Télécharger - Stockage
Format apfs - Guide

6 réponses

Réponse 1 / 6

cs_Le Pivert Messages postés 7904 Date d'inscription Statut Contributeur Dernière intervention 729

Pour détecter un fichier ayant le même nom dans un répertoire:

MsgBox chemin  & Dir(chemin  & "\\" & nom & "*")

Ceci te donne le chemin complet du fichier ayant le même nom, remplacer MsgBox par un variable et après tu adaptes pour supprimer le 1er fichier dont tu connais le chemin complet (regarder sur Google: supprimer un fichier) et enregistrer le nouveau

Blackjack23

Merci cs_Le Pivert mais je ne dois pas être assez doué pour faire la suite car je vois effectivement le message arriver en MsgBox mais lorsque je veux créer ma variable, ça ne marche pas et donc même chose pour la condition que je dois mettre après avec If,Then afin de supprimer le fichier si déjà existant.

Réponse 2 / 6

cs_Le Pivert Messages postés 7904 Date d'inscription Statut Contributeur Dernière intervention 729

Sub Save_classeur() 

Dim chemin, nom, val  As String 

'le chemin pour ouvrir le bon répertoire en allant chercher le numéro du répertoire se trouvant dans la cellule N8 du fichier à enregistrer 

chemin = "C:\Documents and Settings\toto\Mes documents\dossier import test\" & Range("N8").Value & "\" 

'le nom du fichier sera enregistré sous le nom indiqué dans la cellule N11 (n° de série) 

nom = Range("N11").Value 

‘Lancement de l’enregistrement au format Xlsm 
'ActiveWorkbook.SaveAs Filename:=chemin & nom & Format(Now(), "_dd_mm_yyyy") & ".xlsm", FileFormat:=xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False 
val = chemin  & Dir(chemin  & "\\" & nom & "*")
If val = "" Then
Exit Sub
Else
Kill val
End Sub

cs_Le Pivert Messages postés 7904 Date d'inscription Statut Contributeur Dernière intervention 729

correction:

Sub Save_classeur() 

Dim chemin, nom, val  As String 

'le chemin pour ouvrir le bon répertoire en allant chercher le numéro du répertoire se trouvant dans la cellule N8 du fichier à enregistrer 

chemin = "C:\Documents and Settings\toto\Mes documents\dossier import test\" & Range("N8").Value & "\" 

'le nom du fichier sera enregistré sous le nom indiqué dans la cellule N11 (n° de série) 

nom = Range("N11").Value 

'supprimer fichier si existant
val = chemin  & Dir(chemin  & "\\" & nom & "*")
If val = "" Then
Exit Sub
Else
Kill val

‘Lancement de l’enregistrement au format Xlsm 
'ActiveWorkbook.SaveAs Filename:=chemin & nom & Format(Now(), "_dd_mm_yyyy") & ".xlsm", FileFormat:=xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False 

End Sub

Réponse 3 / 6

Blackjack23

Le fichier est bien effacé si le numéro de série et la date sont les mêmes mais si la date est différente, il n’écrase pas l’ancien fichier.

Exemple si le même fichier est enregistré une seconde fois 3 jours plus tard :

555555_10_12_2015 ancien fichier

555555_13_12_2015 le nouveau est fichier créé et l’ancien reste

Réponse 4 / 6

Blackjack23

Pour être plus clair, j'ai lancer le programme indiqué mais lorsqu'il ne trouve pas le même numéro de série, la procédure s’arrête sur "Kill val"et le MsgBox suivant apparaît: "Fichier introuvable";
j'ai donc modifié la procédure de la façon suivante mais mon problème de doublon réapparaît si le fichier existe déjà ce qui est normal car je reviens à mon point de départ, ça fonctionne dans un sens mais pas dans l'autre.

val = chemin & dir(chemin & "\\" & nom & "*")
If val = "" Then
Exit Sub
Else
'Kil val

ActiveWorkbook.SaveAs Filename:=chemin & nom & Format(Now(), "_dd_mm_yyyy") & ".xls", FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False

End If

End Sub

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question

Réponse 5 / 6

cs_Le Pivert Messages postés 7904 Date d'inscription Statut Contributeur Dernière intervention 729

Il y a un problème avec Kill, voici une autre approche:

Sub Save_classeur()
Dim chemin, nom, val As String
Dim objFSO As Variant
 'le chemin pour ouvrir le bon répertoire en allant chercher le numéro du répertoire se trouvant dans la cellule N8 du fichier à enregistrer
chemin = "C:\Documents and Settings\toto\Mes documents\dossier import test\" & Range("N8").Value & "\"
'le nom du fichier sera enregistré sous le nom indiqué dans la cellule N11 (n° de série)
nom = Range("N11").Value
On Error Resume Next 'si pas de fichier existant
'supprimer fichier si existant
val = chemin & Dir(chemin & "\\" & nom & "*")
'on va supprimer le fichier
   Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.DeleteFile (val)
'Lancement de l’enregistrement au format xls
ActiveWorkbook.SaveAs Filename:=chemin & nom & Format(Now(), "_dd_mm_yyyy") & ".xls", FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
MsgBox "Enregister"
End Sub

Réponse 6 / 6

Blackjack23

merci, cette fois ci tout semble fonctionner, c'est parfait

Discussions similaires

je cherche la date et le lieu de naissance d une personne

Votre réponse

Discussions similaires