Macro enregistrement avec date

Bonjour à tous,

dans excel 2010 j'essaie de faire une macro afin d'avoir un enregistrement auto avec la date qui s'ajoute à la fin du fichier.

J'ai ça:

Sub Enregistrement()

'Utilisation d'Outlook sans référence

Dim olApp As Object

Dim olMail

Dim chemin As String, nom As String, fichier As String

chemin = "C:\Users\Asus\Desktop\Travail\"

nom = "Teste" & " - " & Date

ActiveWorkbook.SaveAs Filename:=chemin & nom & ".xlsm", _

FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

ActiveWorkbook.Close True

Set olApp = CreateObject("Outlook.Application")

Set olMail = olApp.CreateItem(0)

fichier = chemin & nom & ".xlsm"

With olMail

.To = "Moi"

.Subject = "TITRE"

.BCC = "Tout le monde"

.Body = "Bonjour à tous"

.Attachments.Add fichier

.Display 'pour visualiser le message

'.Send 'pour envois direct

End With

Set olMail = Nothing

Set olApp = Nothing

End Sub

Mais j'ai message erreur.

Je l'ai mis en Pj.

Quelqu'un a une idée svp?

D'avance merci,

N.

J'ai déja un peu corrigé:

Sub Enregistrement()

Dim olApp As Object

Dim chemin As String, nom As String, fichier As String

chemin = "C:\Users\Asus\Desktop\Travail\"

nom = "Teste" & " - " & Format(Date, "dd mmmm yyyy")

ActiveWorkbook.SaveAs Filename:=chemin & nom & ".xlsm", _

FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

ActiveWorkbook.Close True

End Sub

Mais j'ai une demande de confirmation, et si je dis non ou annuler j'ai un message d'erreur....

Bonjour,

et le message d'erreur tu la lu ? (celui que tu nous montre semble être lié à ton premier code pas le second..)

Oui, cest pour cela que je l'ai corrigé mais je n'en reste pas satisfait. ...

Mais non pas celui avant ta correction ..l'autre!

Bonjour,

La macro que j'utilise et qui fonctionne en enregistrement est celle ci:

Sub Enregistrement()

Dim olApp As Object

Dim chemin As String, nom As String, fichier As String

chemin = "C:\Users\Asus\Desktop\Travail\"

nom = "Teste" & " - " & Format(Date, "dd mmmm yyyy")

ActiveWorkbook.SaveAs Filename:=chemin & nom & ".xlsm", _

FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

End Sub

Sauf que si je réenregistre, il me demande si je veux suprimer le premier et si j'annule ou je répond non j'ai un message d'erreur

Bonjour,

Une proposition à étudier.

Cdlt.

Public Sub DEMO()
Dim Chemin As String, Nom As String
Dim Message As String, Title As String, Buttons As VbMsgBoxStyle, Answer As VbMsgBoxResult
    Chemin = "C:\Users\Asus\Desktop\Travail\"
    Nom = "Teste - " & Format(Date, "dd mmmmm yyyy") & ".xlsm"
    If FileExists(Chemin & Nom) Then
        Message = "Le fichier " & Nom & " existe déja. Souhaitez-vous le conserver ?"
        Title = "Fichier existant"
        Buttons = vbYesNo + vbQuestion
        Answer = MsgBox(Message, Buttons, Title)
        Select Case Answer
            Case vbYes
                Exit Sub
            Case Else
                Application.DisplayAlerts = False
                ActiveWorkbook.SaveAs _
                        Filename:=Chemin & Nom, _
                        FileFormat:=xlOpenXMLWorkbookMacroEnabled
                Application.DisplayAlerts = True
        End Select
    End If
End Sub

Private Function FileExists(strFile As String) As Boolean
    If Dir(strFile) <> "" Then FileExists = True
End Function

Bonjour Jean-Eric,

et merci de ta réponse.

Malheureusement cela ne fonctionne pas.

Pour l'instant, je suis parti sur une autre idée, (heure minute seconde) mais j'ai peur d'avoir une multitude de fichiers ....

Ta macro semble n'avoir aucun effet.

Je t'ai laissé en PJ le fichier que je teste...

N.