Enregistrer un fichier avec date du jour

[Boby71C]

Bonjour à tous

Est-il possible d'enregistrer automatiquement un fichier avec la date du jour qui se met automatiquement dans la nom du fichier ?
Je m'explique

J'ai un fichier quelconque au nom de 'Dupond'. Tant que je l'enregistre sur n'importe quel disque, il conserve son nom d'origine.

Si je décide de l' enregistrer sur le disque D:\\Sauvegardes X\\Dupond.xxx
J'aimerais qu'il prenne automatiquement la date du jour
ex:
D:\\Sauvegardes X\\Dupond-2005-09-20.xxxCeci me permettrais d'avoir des sauvegardes régulières d'un fichier d'une importance capitale.

Merci de votre aide
@+ Robert

 

[Bricofire]

Bonjour Boby 71C

En allant voir :

Lien supprimé

Tu devrais avoir le principal de ta solution

Bon courage,

Bfr

 

[Boby71C]

Bonjour Bricofire et le forum
Merci beaucoup pour ta réponse rapide.
J'ai imprimé le post que tu m'as indiqué et je fais des éssais.
Je te tiens au courant

Merci
@+ Robert

Re

Essai trés concluant je te remercie.
La macro copiée sur le post que tu m'as indiqué !

Sub Sauve_Date()
Dim D As String
Dim N As String
Dim A As Long, togo As Boolean
D = Format(Date, 'ddmmy')
N = IIf(IsNumeric(Mid(ThisWorkbook.FullName, Len(ThisWorkbook.FullName) - 9, 6)), Left(ThisWorkbook.FullName, Len(ThisWorkbook.FullName) - 10), Left(ThisWorkbook.FullName, Len(ThisWorkbook.FullName) - 4))

' enregistre le classeur sous
ThisWorkbook.SaveAs (N & D)

End Sub


J'aurais besoin d'un petit complèment d'un connaisseur
Lorsque j'éxécute la macro, j'aimerais que l'enregistrement se fasse automatiquement sur le disque D répértoire Sauvegardes.
Est-ce Possible ?
Je fais cet éssai sur Excel mais mon besoin est sur MS Project outils de planification avec extension . mpp mais qui fonctionne également en VBA

Merci beaucoup à tous pour l'aide que vous nous apportez
@+ Robert

Message édité par: Boby71C, à: 17/09/2005 11:03

 

[Staple1600]

Bonjour

En m'inspirant du code Sauve_Date()

ATTENTION: je n'ai pas testé
et ne suis pas sur qu'il n'y ait pas de fautes de syntaxe VBA
donc prudence

Sub SVG()
'apres test c'etait point bon
End Sub

Version corrigée

Sub SVG_v2()
Dim Jour, x, z, NomFic As String
x = Application.WorksheetFunction.Find(':\\', ActiveWorkbook.FullName)
z = Mid(ActiveWorkbook.FullName, x + 2, Len(ActiveWorkbook.FullName))
NomFic = Left(z, Len(z) - 4)
Jour = Format(Date, 'ddmmyyyy')
ThisWorkbook.SaveCopyAs Filename:='C:\\Sauvegardes\\' & NomFic & '-' & Jour & '.xls'
End Sub

NB: J'ai mis C:\\Sauvegardes car je n'ai pas de disque D
Pour enregistrer sur lecteur D
je crois qu'il faut insérer ceci (mais je ne peux pas tester)
ChDrive 'D:'
ThisWorkbook.SaveCopyAs Filename:='D:\\Sauvegardes\\' & NomFic & '-' & Jour & '.xls'

Je vous laisse tester

Message édité par: staple1600, à: 17/09/2005 13:29

Message édité par: staple1600, à: 17/09/2005 16:04

 

[Boby71C]

Bonjour Stapel 1600 et le forum
J'ai éssayé votre exemple ci dessous mais un message d'erreur apparaît sur la derniére ligne et rien ne s'enregistre .

Sub SVG_v2()
Dim jour, x, z, NomFic As String
x = Application.WorksheetFunction.Find(':', ActiveWorkbook.FullName)
z = Mid(ActiveWorkbook.FullName, x + 2, Len(ActiveWorkbook.FullName))
NomFic = Left(z, Len(z) - 4)
jour = Format(Date, 'ddmmyyyy')
'ChDrive 'D:'
ThisWorkbook.SaveCopyAs Filename:='D:Sauvegardes' & NomFic & '-' & jour & '.xls'
End Sub
Même en activant le ChDrive 'D:' , ça ne fonctionne pas !
Mon précédent exemple fonctionne bien mais enregistre seulement sur C et avec le même chemin que mon fichier d'origine. Je tenterais d'autres éssais cet après midi et vous tiendrais informé
Merci et trés bon Week End
@+ Robert

 

[Staple1600]

Bonjour

A tester car je ne peux (absence de lectuer D)
Sub SVG_v2.1()
Dim jour, x, z, NomFic As String
x = Application.WorksheetFunction.Find(':', ActiveWorkbook.FullName)
z = Mid(ActiveWorkbook.FullName, x + 2, Len(ActiveWorkbook.FullName))
NomFic = Left(z, Len(z) - 4)
jour = Format(Date, 'ddmmyyyy')
ChDrive 'D:'
ChDir 'D:&#92Sauvegardes'
ThisWorkbook.SaveCopyAs Filename:=NomFic & '-' & jour & '.xls'
End Sub

 

[Boby71C]

Bonjour Staple1600 et le forum
Merci beaucoup pour l'aide que vous m'apportez.
Malheureusement, ça ne fonctionne pas, j'ai le message suivant:

Erreur d'exécution '1004':
Fichier inaccessible. Essayez l'une des opérations suivantes:

Vérifiez que le dossier spécifié existe.
Vérifiez que le dossier dans lequel se trouve le fichier n'est pas en lecture seule.
Vérifiez que le nom du fichier ne comporte les caractères suivants:
<>?[]:ni*

J'ai contrôlé et tout a l'air bon. Je ne sais plus quoi faire !

Merci de votre aide
@+ Robert

 

[Staple1600]

Bonjour

J'ai trouvé un PC avec un lecteur E au boulot
et ca fonctionne

voir code ci dessous:

Sub SVG_v23()
Dim jour, x, z, NomFic As String
x = Application.WorksheetFunction.Find(':', ActiveWorkbook.FullName)
z = Mid(ActiveWorkbook.FullName, x + 2, Len(ActiveWorkbook.FullName))
NomFic = Left(z, Len(z) - 4)
jour = Format(Date, 'ddmmyyyy')
ChDrive 'D'
ChDir '\\\\\\\\Sauvegardes\\\\\\\\'
ThisWorkbook.SaveCopyAs Filename:=NomFic & '-' & jour & '.xls'
End Sub

Message édité par: staple1600, à: 19/09/2005 10:56

Message édité par: staple1600, à: 20/09/2005 14:19

Message édité par: staple1600, à: 20/09/2005 14:20

 

[Boby71C]

Bonjour Staple et le forum
J'ai éssayé et je suis nul de chez nul car j'ai toujour le même message !!
Je ne comprend pas se qu'il se passe.
Merci quand même de votre aide
@+ Robert

 

[Staple1600]

Je viens de réssayer

J'ai créé test.xls sur le lecteur E ( à la racine)

J'ai un répertoire Sauvegardes sur C

(en adaptant avec la lettre de lecteur adéquate: ici C)

la macro fonctionne

J'obtiens bien une copie dans C:\\\\\\\\Sauvegardes
nommée test-20092005.xls


Ton lecteur ne serait-il pas un lecteur virtuel?
sur un réseau

 

[Boby71C]

Bonjour Stapel et le forum
Je suis vraiement désolé d'abuser de ton temps. Ci dessous la macro qui ne fonctionne toujour pas chez moi.

J'ai beau me coller les yeux sur le texte pour contrôler si je n'ai pas fais d'erreur, rien ne fonctionne.
mon disque n'est pas sur réseau, il est seulement partitionné.
J'ai éssayé directement sur C avec un répèrtoire 'Sauvegardes' et rien de plus.
Ligne rouge ne fonctionne pas.
Peut être est-ce un problême de case non cochée dans les macros complèmentaires car j'ai seulement de coché 'outils pour l'Euro'

Sub SVG_v23()
Dim jour, x, z, NomFic As String
x = Application.WorksheetFunction.Find(':', ActiveWorkbook.FullName)
z = Mid(ActiveWorkbook.FullName, x + 2, Len(ActiveWorkbook.FullName))
NomFic = Left(z, Len(z) - 4)
jour = Format(Date, 'ddmmyyyy')
ChDrive 'D:'
ChDir '\\Sauvegardes\\'
ThisWorkbook.SaveCopyAs Filename:=NomFic & '-' & jour & '.xls'
End Sub

Je te remercie du temps que tu as bien voulu m'accorder mais je pense que d'autres internautes ont besoins de ton savoir.
Merci beaucoup de l'aide apportée.
@+ Robert

 

[Boby71C]

Bonjour Stapel1600 et le forum

Toujour pareil. Je suis découragé.
Je joint mon fichier avec le message d'erreur inclus.
Merci beaucoup pour ton aide.

@+ Robert
[file name=EssaiDate.zip size=19138]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/EssaiDate.zip[/file]

 

[Staple1600]

Bonjour



Cette fois-ci ça doit fonctionner

Option Explicit
Function MyName() As String
MyName = ThisWorkbook.Name
End Function
Sub SVG_v24()
Dim jour$, NomFic$
NomFic = Left(MyName, Len(MyName) - 4)
jour = Format(Date, "ddmmyyyy")
ChDrive "C": ChDir "\Sauvegardes\"
ThisWorkbook.SaveCopyAs Filename:=NomFic & "-" & jour & ".xls"
End Sub

Message édité par: staple1600, à: 22/09/2005 09:29

 

[Boby71C]

Bonsoir à tous

Merci beaucoup Stapel1600 ça fonctionne

Vive les pros du VBA

Merci beaucoup à toi et à l'ensemble des volontaires de se merveilleux forum que je ne manque pas de recommander.

Il ne me reste plus qu'à adapter la même chose dans MS Project car j'ai fais un éssai mais il n'a pas l'air d'avoir les mêmes codes que dans Excel. Pourtant, c'est du VBA

Trés longue vie aux VBIstes

A+ et encore merci
Robert