Ouvrir fichier s'il existe dejà

Bonjour a tous,

J'ai crée un programme me permettant d'envoyer une feuille excel par mail via lotus et de l'enregistrer dans un repertoire precis. Cela fonctionne tres bien.

Cependant j'ai un souci si je demande de renvoyer la meme feuille.

Il me met "Un fichier nommé C:/........ existe déja à cet emplacement. Voulez vous le remplacer?

Si je met Oui il ecrase et envoi le mail mais si je fais Non ou Annuler sa bug

Moi ce que je voudrai c'est que si le fichier existe deja, il demande à la place s'il veut ouvrir le fichier deja crée

Si Oui, il ouvre le fichier dans le repertoire

Si Non ferme le classeur sans enregistrer

Je mets en dessous tous mes codes car car j'ai 2 systeme d'enregistrement ( temporaire et fixe ) qui fonctionne l'un a la suite de l'autre. Et le probleme c'est que je vois pas dans lequel je dois modifier

Merci d'avance

Option Explicit

Const EMBED_ATTACHMENT As Long = 1454

Const stPath As String = "C:\XXX"

Const vaMsg As Variant = "Bonjour," & vbCrLf & vbCrLf & vbCrLf & "Voici le formulaire" & vbCrLf & vbCrLf & "Cordialement"

Sub Send_Active_Sheet()

Dim stFileName As String
Dim vaRecipients As Variant

Dim noSession As Object
Dim noDatabase As Object
Dim noDocument As Object
Dim noEmbedObject As Object
Dim noAttachment As Object
Dim stAttachment As String

'Copy the active sheet to a new temporarily workbook.
With ActiveSheet
.Copy
stFileName = .Range("G7").Value
End With

stAttachment = stPath & "\" & stFileName & ".xls"

'Save and close the temporarily workbook.
With ActiveWorkbook
.SaveAs stAttachment
.Close
End With

'Create the list of recipients.
vaRecipients = VBA.Array("XX@XX.fr")

'Instantiate the Lotus Notes COM's Objects.
Set noSession = CreateObject("Notes.NotesSession")
Set noDatabase = noSession.GetDatabase("", "")

'If Lotus Notes is not open then open the mail-part of it.
If noDatabase.IsOpen = False Then noDatabase.OPENMAIL

'Create the e-mail and the attachment.
Set noDocument = noDatabase.CreateDocument
Set noAttachment = noDocument.CreateRichTextItem("stAttachment")
Set noEmbedObject = noAttachment.EmbedObject(EMBED_ATTACHMENT, "", stAttachment)

'Add values to the created e-mail main properties.
With noDocument
.Form = "Memo"
.SendTo = vaRecipients
.Subject = stFileName
.Body = vaMsg
.SaveMessageOnSend = True
.PostedDate = Now()
.Send 0, vaRecipients
End With

'Delete the temporarily workbook.
Kill stAttachment

'Release objects from memory.
Set noEmbedObject = Nothing
Set noAttachment = Nothing
Set noDocument = Nothing
Set noDatabase = Nothing
Set noSession = Nothing

MsgBox "Email crée et envoyé avec succès", vbInformation
End Sub

Private Sub EnvoyerMail_Click()
Call Archiver
Call Send_Active_Sheet
End Sub

Sub Archiver()

Dim extension As String
Dim chemin As String, nomfichier As String
Dim style As Integer
Application.ScreenUpdating = False
ThisWorkbook.ActiveSheet.Copy
extension = ".xls"
chemin = "C:\XXX"
nomfichier = ActiveSheet.Range("G7") & extension
With ActiveWorkbook
.SaveAs Filename:=chemin & nomfichier
.Close
End With
End Sub

Bonjour

Une solution à tester

A chaque appel de la macro le fichier existant sera remplacé mais sans message d'erreur (d'avertissement)

  'Save and close the temporarily workbook.
  Application.DisplayAlerts = False
  With ActiveWorkbook
    .SaveAs stAttachment
    .Close
  End With
  Application.DisplayAlerts = True

C'est pas sa je me suis peut etre mal expliqué

En résumé c'est sa que je veux:

-Si le fichier existe déjà :

si on met Oui, il ferme sans enregistrer le classeur en cours et ouvre l'existant

si on met non, il ferme sans enregistrer le classeur en cours

-S'il n'existe pas

on enregistre le classeur en cours

Je remets mon code avec des modif mais j'ai toujours un petit probleme

Voici les conditions que je veux :

- Si le fichier n'existe pas : le fichier est enregistré dans un repertoire precis et il est envoye par mail.

-Si le fichier existe et que je choisi "OUI" pour l'ouvrir : Ouvre le fichier deja enregistre dans le repertoire, ferme celui en cours et le mail n'est pas envoye

-Si le fichier existe et que je choisi "NON" pour l'ouvrir : N'ouvre pas le fichier deja enregistrer dans le repertoire et le mail n'est pas envoyé

Les 2 dernieres conditions marche nikel le souci viens du 1er :

Le mail ne s'envoi pas

Quelqu'un peut il m'aider c'est urgent svp Merci

Option Explicit

Const EMBED_ATTACHMENT As Long = 1454

Const stPath As String = "C:\Documents and Settings\TECHNICI\Bureau"

Const vaMsg As Variant = "Bonjour," & vbCrLf & vbCrLf & vbCrLf & "Voici le formulaire" & vbCrLf & vbCrLf & "Cordialement"

Dim bExist As Boolean

Sub Send_Active_Sheet()

  Dim stFileName As String
  Dim vaRecipients As Variant

  Dim noSession As Object
  Dim noDatabase As Object
  Dim noDocument As Object
  Dim noEmbedObject As Object
  Dim noAttachment As Object
  Dim stAttachment As String

  'Copy the active sheet to a new temporarily workbook.
  With ActiveSheet
    .Copy
    stFileName = .Range("G7").Value
  End With

  stAttachment = stPath & "\" & stFileName & ".xls"

  'Save and close the temporarily workbook.
   With ActiveWorkbook
    .SaveAs stAttachment
    .Close
  End With

  'Create the list of recipients.
  vaRecipients = VBA.Array("XX@XX.fr")

  'Instantiate the Lotus Notes COM's Objects.
  Set noSession = CreateObject("Notes.NotesSession")
  Set noDatabase = noSession.GetDatabase("", "")

  'If Lotus Notes is not open then open the mail-part of it.
  If noDatabase.IsOpen = False Then noDatabase.OPENMAIL

  'Create the e-mail and the attachment.
  Set noDocument = noDatabase.CreateDocument
  Set noAttachment = noDocument.CreateRichTextItem("stAttachment")
  Set noEmbedObject = noAttachment.EmbedObject(EMBED_ATTACHMENT, "", stAttachment)

  'Add values to the created e-mail main properties.
  With noDocument
    .Form = "Memo"
    .SendTo = vaRecipients
    .Subject = stFileName
    .Body = vaMsg
    .SaveMessageOnSend = True
    .PostedDate = Now()
    .Send 0, vaRecipients
  End With

  'Delete the temporarily workbook.
  Kill stAttachment

  'Release objects from memory.
  Set noEmbedObject = Nothing
  Set noAttachment = Nothing
  Set noDocument = Nothing
  Set noDatabase = Nothing
  Set noSession = Nothing

  MsgBox "Email crée et envoyé avec succès", vbInformation
End Sub

Private Sub EnvoyerMail_Click()
Call Archiver
If bExist = True Then Call Send_Active_Sheet
End Sub

Sub Archiver()

Dim extension As String
Dim chemin As String, nomfichier As String
Dim style As Integer, bOuvre As Boolean
    Application.ScreenUpdating = False
    ThisWorkbook.ActiveSheet.Copy
    extension = ".xls"
    chemin = "C:\Documents and Settings\TECHNICI\Bureau\Fichier\"
    nomfichier = ActiveSheet.Range("G7") & extension
    bExist = (Dir(chemin & nomfichier) <> "")
     If bExist Then
        bOuvre = (MsgBox(PROMPT:="un fichier de ce nom existe déjà, l'ouvrir ?", Buttons:=vbYesNo) = vbYes)
        ActiveWorkbook.Close False
        If bOuvre Then Workbooks.Open Filename:=chemin & nomfichier
    Else
        With ActiveWorkbook
            .SaveAs Filename:=chemin & nomfichier
            .Close
        End With
    End If
End Sub