[XL-2003] pb condition pour envoi mail

Bonjour a tous

J'ai crée un programme pour le taf me permettant d'envoyer un fichier excel par mail via Lotus.
Mais j'ai un souci sur definir quand il doit l'envoyer.

Voici le cheminement complet du programme:

Le formulaire est crée via un code mis sur un autre fichier excel

Lorsque le formulaire est crée, il faut cliquez sur un bouton pour l'envoyer par mail et l'enregistrer dans un repertoire precis.

C'est la que le probleme commence

Si le fichier n'existe pas dans le repertoire : (OK)
Le fichier est enregistre dans le repertoire et est envoye par mail

Si le fichier existe et que l'on veut l'ouvrir via Msgbox
Le fichier enregistré dans le repertoire s'ouvre (OK)
Le fichier temporairement crée se ferme (OK)
Le fichier n'est pas envoyé par mail (KO)

Si le fichier existe et que l'on ne veut pas l'ouvrir
Le fichier enregistré dans le repertoire ne s'ouvre pas (OK)
Le fichier temporaire se ferme (OK)
Le fichier n'est pas envoyé par mail (KO)

Donc en resumé :

Je voudrais que si l'une des 2 dernieres conditions est choisie, le mail ne s'envoie pas

J'espere que mon explication est clair

Ci dessous le code

Merci d'avance

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
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 = False Then Call Send_Active_Sheet
End Sub

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
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