[VBA] Sauvegarder sous un autre nom si déjà existant

[mikael2403]

Bonjour,

Je rencontre une problématique avec une macro.
Je demande à ce qu'un fichier soit enregistré. Il peut être enregistré plusieurs fois par jour.
La problématique que je rencontre c'est que si le fichier est enregistré 1 fois, la 2e fois il va écraser le 1er.

Existe-t-il un moyen de vérifier si un fichier du même nom existe déjà ? si oui, ajouté "- 1" ou "- 2" etc...

Voici mon code :

Dim Fichier As String
x = Range("D5").Value
Fichier = Format(Date, "yymmdd") & " - " & x & ".xls"
Sheets("Propale").Copy
ActiveWorkbook.SaveAs Filename:="T:\PROPALE\" & Fichier, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="PROPALE", ReadOnlyRecommended:=True _
, CreateBackup:=False

Il me semble avoir déjà vu sur un forum cette solution mais impossible de la retrouver.

Merci d'avance pour votre aide.

Mikael.

 

[Pierrot93]

Re : [VBA] Sauvegarder sous un autre nom si déjà existant

Bonjour Mikael

regarde la macro ci dessous, si j'ai bien compris :

Sub test()
Dim x As String, i As Byte
Do
    x = Dir(ThisWorkbook.Path & "\" & Format(Date, "yymmdd") & "-" & i + 1 & ".xls")
    i = i + 1
Loop While x <> ""
ThisWorkbook.SaveAs Format(Date, "yymmdd") & "-" & i & ".xls"
End Sub

bon après midi
@+

 

[phlaurent55]

Re : [VBA] Sauvegarder sous un autre nom si déjà existant

Salut Mikael,

une petite piste, puisque ton fichier peut être sauvegardé plusieurs fois par jour ,yymmdd ne changeras pas au cours d'une même journée

Fichier = Format(Date, "yymmdd") & " - " & x & ".xls"

tu devrais egalement tenir compte de l'heure ( avec min. et sec.) qui ne sera jamais la même au cours de la journée.
à+

Aie: Collision avec Pierrot.............ça te fera 2 réponses

 

[mikael2403]

Re : [VBA] Sauvegarder sous un autre nom si déjà existant

Merci pour vos réponses rapide.

Je ne sais pas si j'ai bien expliqué ce que je recherche à faire.
J'ai utilisé la solution de Pierrot93 mais le 1 se met en fin de fichier à chaque enregistrement.
J'ai un 1er fichier source. Je duplique la feuil1 dans un nouveau classeur.
Ensuite j'éxecute la sauvegarde qui doit prendre en compte :
1) La date au format yymmdd
2) la valeur de la cellule D5
3) Le sauvegarder dans un dossier nommmé PROPALE
Donc ça peut donner par exemple :
082702 - TEST.xls

J'éxecute cette sauvegarde plusieurs fois par jour.
Lorsque j'éxécute une 2nd sauvegarde, je souhaite que :
1) Excel vérifie dans le dossier PROPALE que ce fichier n'existe pas.
2) Si non, enregistrement comme l'exemple ci-dessus
3) Si oui, enregistrement comme l'exemple ci-dessus avec une extension supplémentaire qui pourrait être par exemple "*- 1.xls"
4) Si c'est le 3e enregistrement '*- 2.xls"
5) Ex : Dans mon dossier PROPALE après 2nd enresgitrement je pourrai donc visualiser :
082702 - TEST.xls
082702 - TEST - 1.xls
Etc...

J'ai donc essayé d'adapter le code de Pierrot93 à ma macro existante, ce qui donne :

Sub Test()
Dim Fichier As String, i As Byte
Dim x As String
Do
    x = Dir(ThisWorkbook.Path & "\" & Format(Date, "yymmdd") & " - " & y & " - " & i + 1 & ".xls")
    i = i + 1
    y = Range("D5").Value
Loop While x <> ""
Sheets("Feuil1").Copy
ActiveWorkbook.SaveAs Filename:="T:\PROPALE\" & Format(Date, "yymmdd") & "-" & y & " - " & i & ".xls", _
FileFormat:=xlNormal, Password:="", WriteResPassword:="PROPALE", ReadOnlyRecommended:=True _
, CreateBackup:=False
End Sub

Ce code fonctionne mais il ne change pas l'extension de mon fichier.
Si le fichier existe déjà, il écrase le fichier du dossier PROPALE.
Il ne vérifie pas si le fichier existe déjà et le nomme toujours avec "- 1" à la fin.

Ai-je oublié une étape ou cette solution n'est elle pas adapté à ce que je cherche ?

Merci encore pour votre aide.

Mikael

 

[Pierrot93]

Re : [VBA] Sauvegarder sous un autre nom si déjà existant

Re, bonjour PhLaurent

peut être comme ceci alors :

Sub test()
Dim x As String, i As Byte
x = Dir(ThisWorkbook.Path & "\" & Format(Date, "yymmdd") & ".xls")
If x <> "" Then
    Do
        x = Dir(ThisWorkbook.Path & "\" & Format(Date, "yymmdd") & "-" & i + 1 & ".xls")
        i = i + 1
    Loop While x <> ""
    ThisWorkbook.SaveAs Format(Date, "yymmdd") & "-" & i & ".xls"
Else
    ThisWorkbook.SaveAs Format(Date, "yymmdd") & ".xls"
End If
End Sub

bonne fin d'après midi
@+

 

[mikael2403]

Re : [VBA] Sauvegarder sous un autre nom si déjà existant

Bonjour Pierrot93,

Je te remercie pour ta réponse.
Mon fichier doit être enregistré dans un autre dossier que celui d'origine.
Ce dossier est toujours le même.
Est-il possible de faire la vérification dans celui-ci ?

Merci d'avance

 

[Pierrot93]

Re : [VBA] Sauvegarder sous un autre nom si déjà existant

Bonjour Mikael

remplaces dans le code :

ThisWorkbook.Path & "\"

par :

(chemin du fichier à adapter)

"C:\MesDocuments\Excel\Test\"

@+