Supprimer macro avant envoi fichier par Mail

**mattwarend** · 12/11/2008, 14h20

Bonjour à tous,

Merci à tous ceux qui m'ont une nouvelle fois aidé à réaliser ma macro qui permet d'envoyer mon fichier par mail.

Je rencontre cependant un nouveau problème.
Je cherche à l'automatiser avec auto_open ce qui fonctionne, mais mon fichier envoyé contient donc ma macro (avec le auto_open) et la macro se lance donc à l'ouverture de mon fichier envoyé.

Comment procéder pour que cette macro soit désactivée avant envoi, ou supprimée ?

Ci-joint mon code pour info :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
Sub auto_open ()
 
    Cells.Select
    Selection.ClearContents
    Range("A1").Select
 
    Workbooks.OpenText Filename:= _
        "C:\Documents and Settings\moi\Desktop\Usage.txt", Origin:=xlMSDOS, _
        StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=True, Comma:=False _
        , Space:=False, Other:=False, FieldInfo:=Array(1, 1), _
        TrailingMinusNumbers:=True
Range("A1").Select
 
    ActiveWorkbook.Save
 
On Error Resume Next
 
 
    Dim Maildb As Object 'The mail database
    Dim UserName As String 'The current users notes name
    Dim MailDbName As String 'THe current users notes mail database name
    Dim MailDoc As Object 'The mail document itself
    Dim AttachME As Object 'The attachment richtextfile object
    Dim Session As Object 'The notes session
    Dim EmbedObj As Object 'The embedded object (Attachment)
    Dim dest As String
    Dim monTab() As String
 
 
    Set Session = CreateObject("Notes.NotesSession")
    UserName = Session.UserName
    MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
    'Open the mail database in notes
    Set Maildb = Session.GetDatabase("", MailDbName)
     If Maildb.IsOpen = True Then
          'Already open for mail
     Else
 
     Maildb.OPENMAIL
 
     End If
    'Set up the new mail document
    Set MailDoc = Maildb.CreateDocument
    MailDoc.Form = "Memo"
    MailDoc.Subject = "Envoi Automatique Alerte Quota FS01"
    MailDoc.body = "Alerte de Quota sur FS01"
    MailDoc.SAVEMESSAGEONSEND = saveit
 
    Attachment = ThisWorkbook.FullName
    If Attachment <> "" Then
        Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment")
        Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", Attachment, "Attachment")
        MailDoc.CREATERICHTEXTITEM ("Attachment")
    End If
 
    'Send the document
    dest = Sheets("MACRO").Range("A1") & ", " & Sheets("MACRO").Range("A2")
    monTab = Split(dest, ",")
    MailDoc.Send 0, monTab()
    MailDoc.PostedDate = Now()
 
    'Clean Up
    Set Maildb = Nothing
    Set MailDoc = Nothing
    Set AttachME = Nothing
    Set Session = Nothing
    Set EmbedObj = Nothing
 
    Excel.Application.Quit
    Application.DisplayAlerts = False
 
End Sub

**Godzestla** · 12/11/2008, 14h25

Re,

je t'ai envoyé une solution par mp il y a 1/2h.

**mattwarend** · 12/11/2008, 14h37

Merci ! Je viens de voir ton message.

En fait, je ne sais pas trop où placer le code que tu m'a indiqué :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
 
Sheets("Parms").Range("A1") = 0
Thisworkbook.saveCopyas Filename:=newname
Sheets("Parms").Range("A1") = 1
if Sheets("Parms").Range("A1") = 1 then
  '... trt email
endif

**Godzestla** · 12/11/2008, 14h50

Je n'ai pas l'impression que tu lis ce que je t'envoi......

Essaie encore.

**mattwarend** · 12/11/2008, 14h55

Envoyé par Godzestla

Je n'ai pas l'impression que tu lis ce que je t'envoi......

Essaie encore.

Si !!!

J'ai bien ajouté la feuille PARMS comme tu me l'a indiqué.

**Godzestla** · 12/11/2008, 15h23

Oui, mais j'avais expliqué plus. Tidju...

Allez en vitesse et sans test possible.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
80
81
Sub auto_open ()
 
    Cells.Select
    Selection.ClearContents
    Range("A1").Select
 
    Workbooks.OpenText Filename:= _
        "C:\Documents and Settings\moi\Desktop\Usage.txt", Origin:=xlMSDOS, _
        StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=True, Comma:=False _
        , Space:=False, Other:=False, FieldInfo:=Array(1, 1), _
        TrailingMinusNumbers:=True
Range("A1").Select
    
    ActiveWorkbook.Save
 
On Error Resume Next
 
 
    Dim Maildb As Object 'The mail database
    Dim UserName As String 'The current users notes name
    Dim MailDbName As String 'THe current users notes mail database name
    Dim MailDoc As Object 'The mail document itself
    Dim AttachME As Object 'The attachment richtextfile object
    Dim Session As Object 'The notes session
    Dim EmbedObj As Object 'The embedded object (Attachment)
    Dim dest As String
    Dim monTab() As String
    Dim newname as string
 
     
if Sheets("Parms").Range("A1") = 1 then   
    Set Session = CreateObject("Notes.NotesSession")
    UserName = Session.UserName
    MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
    'Open the mail database in notes
    Set Maildb = Session.GetDatabase("", MailDbName)
     If Maildb.IsOpen = True Then
          'Already open for mail
     Else
      
     Maildb.OPENMAIL
            
     End If
    'Set up the new mail document
    Set MailDoc = Maildb.CreateDocument
    MailDoc.Form = "Memo"
    MailDoc.Subject = "Envoi Automatique Alerte Quota FS01"
    MailDoc.body = "Alerte de Quota sur FS01"
    MailDoc.SAVEMESSAGEONSEND = saveit
    
   Sheets("Parms").Range("A1") = 0
    newname = "C:\Test.xls"
    Thisworkbook.saveCopyas Filename:=newname
    Sheets("Parms").Range("A1") = 1
    Attachment = newname
    If Attachment <> "" Then
        Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment")
        Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", Attachment, "Attachment")
        MailDoc.CREATERICHTEXTITEM ("Attachment")
    End If
   
    'Send the document
    dest = Sheets("MACRO").Range("A1") & ", " & Sheets("MACRO").Range("A2")
    monTab = Split(dest, ",")
    MailDoc.Send 0, monTab()
    MailDoc.PostedDate = Now()
    
    'Clean Up
    Set Maildb = Nothing
    Set MailDoc = Nothing
    Set AttachME = Nothing
    Set Session = Nothing
    Set EmbedObj = Nothing
    
    Excel.Application.Quit
    Application.DisplayAlerts = False

endif
End Sub

**mattwarend** · 12/11/2008, 15h48

Hello,

Je viens de modifier mon code, et ça semble fonctionner :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
80
Sub Sendmail()
 
    Cells.Select
    Selection.ClearContents
    Range("A1").Select
 
    Workbooks.OpenText Filename:= _
        "C:\Documents and Settings\brunautma\Desktop\Usage.txt", Origin:=xlMSDOS, _
        StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=True, Comma:=False _
        , Space:=False, Other:=False, FieldInfo:=Array(1, 1), _
        TrailingMinusNumbers:=True
    Cells.Select
 
ActiveWorkbook.Save
 
On Error Resume Next
 
 
    Dim Maildb As Object 'The mail database
    Dim UserName As String 'The current users notes name
    Dim MailDbName As String 'THe current users notes mail database name
    Dim MailDoc As Object 'The mail document itself
    Dim AttachME As Object 'The attachment richtextfile object
    Dim Session As Object 'The notes session
    Dim EmbedObj As Object 'The embedded object (Attachment)
    Dim dest As String
    Dim monTab() As String
 
 
    Set Session = CreateObject("Notes.NotesSession")
    UserName = Session.UserName
    MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
    'Open the mail database in notes
    Set Maildb = Session.GetDatabase("", MailDbName)
     If Maildb.IsOpen = True Then
          'Already open for mail
     Else
 
     Maildb.OPENMAIL
 
     End If
    'Set up the new mail document
    Set MailDoc = Maildb.CreateDocument
    MailDoc.Form = "Memo"
    MailDoc.Subject = "Envoi Automatique Alerte Quota FS01"
    MailDoc.body = "Alerte de Quota sur FS01"
    MailDoc.SAVEMESSAGEONSEND = saveit
 
    Attachment = ThisWorkbook.FullName
    If Attachment <> "" Then
        Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment")
        Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", Attachment, "Attachment")
        MailDoc.CREATERICHTEXTITEM ("Attachment")
    End If
 
   Sheets("Parms").Range("A1") = 0
    ThisWorkbook.SaveCopyAs Filename:="C:\Quota Alerte Mail.xls"
    Sheets("Parms").Range("A1") = 1
    If Sheets("Parms").Range("A1") = 1 Then
 
    End If
 
    'Send the document
    dest = Sheets("MACRO").Range("A1") & ", " & Sheets("MACRO").Range("A2")
    monTab = Split(dest, ",")
    MailDoc.Send 0, monTab()
    MailDoc.PostedDate = Now()
 
    'Clean Up
    Set Maildb = Nothing
    Set MailDoc = Nothing
    Set AttachME = Nothing
    Set Session = Nothing
    Set EmbedObj = Nothing
 
    Excel.Application.Quit
    Application.DisplayAlerts = False
 
End Sub

Le comportement est un peu bizarre, il me copie les données dans la feuille PARMS. Je vais tenter donc de supprimer les feuilles qui ne servent plus.

Dans ma colonne E, j'ai plusieurs valeurs.
Je voudrais faire en sorte que si la valeur dans la colonne E est inférieure à 99,5, ne rien faire.
C'est possible ?

**mattwarend** · 13/11/2008, 10h01

Godzestla,

Comme indiqué plus haut, ça fonctionne maintenant.
Reste que dans ma colonne E, j'ai plusieurs valeurs et que je voudrais faire en sorte que si la valeur dans la colonne E est inférieure à 99,5, ne rien faire.
C'est possible ?

**Godzestla** · 13/11/2008, 10h05

Envoyé par mattwarend

Godzestla,

Reste que dans ma colonne E, j'ai plusieurs valeurs et que je voudrais faire en sorte que si la valeur dans la colonne E est inférieure à 99,5, ne rien faire.
C'est possible ?

Qu'est-ce à dire ? Une cellule < 99,5 ou le total ?

**mattwarend** · 13/11/2008, 10h22

Une des valeurs qui sont dans les cellules de la colonne E est < 99,5

**Godzestla** · 13/11/2008, 11h10

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
 
Sub Call_send_mail()
Dim result As Boolean
result = True
With Sheets(Activesheet)
For Each cell In .Range(Range("E65536").End(xlUp), Range("E1"))
 If cell.Value < 99.5 Then
    result = False
 End If
Next
End With
if result then 
  Sendmail
endif
 
 
End Sub

**mattwarend** · 13/11/2008, 11h44

Je rencontre un erreur sur cette ligne :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

With Sheets(ActiveSheet)

Erreur d'exécution '13' : Incompatibilité de type

**Godzestla** · 13/11/2008, 11h51

Autant pour moi,

il faut écrite

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
with activesheet

**mattwarend** · 13/11/2008, 12h16

Euh, en fait il ne se passe rien...
Ci-joint mon code complet pour info :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
 
Sub Call_send_mail()
Dim result As Boolean
result = True
With ActiveSheet
For Each cell In .Range(Range("E65536").End(xlUp), Range("E1"))
 If cell.Value < 99.5 Then
    result = False
 End If
Next
End With
If result Then
  Sendmail
End If
 
 
End Sub
 
Sub Sendmail()
 
    Cells.Select
    Selection.ClearContents
    Range("A1").Select
 
    ChDir "C:\Documents and Settings\admincot\Desktop"
    Workbooks.OpenText Filename:="\\eufrhqfs01wp\QUOTALOG\Usage.txt", Origin:= _
        xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote _
        , ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=True, Comma:= _
        False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), _
        TrailingMinusNumbers:=True
 
    ActiveWorkbook.Save
 
On Error Resume Next
 
 
    Dim Maildb As Object 'The mail database
    Dim UserName As String 'The current users notes name
    Dim MailDbName As String 'THe current users notes mail database name
    Dim MailDoc As Object 'The mail document itself
    Dim AttachME As Object 'The attachment richtextfile object
    Dim Session As Object 'The notes session
    Dim EmbedObj As Object 'The embedded object (Attachment)
    Dim dest As String
    Dim monTab() As String
 
 
    Set Session = CreateObject("Notes.NotesSession")
    UserName = Session.UserName
    MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
    'Open the mail database in notes
    Set Maildb = Session.GetDatabase("", MailDbName)
     If Maildb.IsOpen = True Then
          'Already open for mail
     Else
 
     Maildb.OPENMAIL
 
     End If
    'Set up the new mail document
    Set MailDoc = Maildb.CreateDocument
    MailDoc.Form = "Memo"
    MailDoc.Subject = "Envoi Automatique Alerte Quota FS01"
    MailDoc.body = "Alerte de Quota sur FS01"
    MailDoc.SAVEMESSAGEONSEND = saveit
 
       Sheets("Parms").Range("A1") = 0
       newname = "C:\Quota Alerte Mail"
    ThisWorkbook.SaveCopyAs Filename:=newname
    Sheets("Parms").Range("A1") = 1
    Attachment = newname
 
      If Attachment <> "" Then
        Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment")
        Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", Attachment, "Attachment")
        MailDoc.CREATERICHTEXTITEM ("Attachment")
    End If
 
 
 
    'Send the document
    dest = Sheets("MACRO").Range("A1") & ", " & Sheets("MACRO").Range("A2")
    monTab = Split(dest, ",")
    MailDoc.Send 0, monTab()
    MailDoc.PostedDate = Now()
 
    'Clean Up
    Set Maildb = Nothing
    Set MailDoc = Nothing
    Set AttachME = Nothing
    Set Session = Nothing
    Set EmbedObj = Nothing
 
    Excel.Application.Quit
    Application.DisplayAlerts = False
 
End Sub

**Godzestla** · 18/11/2008, 11h53

Bonjour,

tu connais quelqu'un qui mérité une fessée magistrale parce qu'il n'a pas fait ce qu'on lui a dit et que donc son problème qui devrait être résolu ne l'est pas ? Toi.

Dans le feuille Parms en "A1", il faut 1 et pas rien.

tant qu'à faire, j'ai un peu revu ton code au niveau de l'Auto_open qui en avait bien besoin, mais juste en vitesse.
Les tests étaient très mal positionnés.
J'ai ajouté une demande avant l'envoi. Si tu n'en veus pas, mets en commentaires les 3 lignes flaggées dans ce sens.

Et... pas la peine de me dire que cela ne marche pas si tu n'a pas mis 1 ou il faut avant.

Voici un code un poeu meilleur. Essaie de passer du temps à comprendre un peu sinon, à quoi bon.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
 
Sub auto_open()
    Dim Msg, Style, Title, Help, Ctxt, Response, MyString
    If Sheets("Parms").Range("A1") = 1 Then
        Msg = "Do you want to Send the Mail ?"    ' Define message.
        Style = vbYesNo + vbCritical + vbDefaultButton2    ' Define buttons.
        Title = "MsgBox Send"    ' Define title.
        Help = "DEMO.HLP"    ' Define Help file.
        Ctxt = 1000    ' Define topic
        ' context.
        ' Display message.
        Response = MsgBox(Msg, Style, Title, Help, Ctxt)    'METTRE EN COMMENTAIRE
        If Response = vbYes Then    ' User chose Yes.       'METTRE EN COMMENTAIRE
            send_email
        End If                                              'METTRE EN COMMENTAIRE
 
    End If
End Sub
Sub send_email()
 
        Cells.Select
        Selection.ClearContents
        Range("A1").Select
 
 
 
        'ChDir "C:\Documents and Settings\admincot\Desktop"
        Workbooks.OpenText Filename:="C:\DATA\Test\testexcel\Usage.txt", Origin:= _
            xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote _
            , ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=True, Comma:= _
            False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), _
            TrailingMinusNumbers:=True
        Cells.Select
        Selection.Copy
        Windows("Classeur1.xls").Activate
        ActiveSheet.Paste
        Columns("E:E").Select
        Selection.Replace What:=".", Replacement:=",", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
        Application.CutCopyMode = False
            With Selection
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlBottom
            .WrapText = False
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
            End With
        Selection.NumberFormat = "0.00"
        Rows("8:8").Select
        Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
        Selection.Sort Key1:=Range("E8"), Order1:=xlDescending, Header:=xlGuess, _
           OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
         DataOption1:=xlSortNormal
        Selection.AutoFilter
        Selection.AutoFilter Field:=5, Criteria1:=">99,5", Operator:=xlAnd
        Range("A6").Select
        Selection.TextToColumns Destination:=Range("A6"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
            Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
            :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), _
            TrailingMinusNumbers:=True
        Rows("4:4").Select
    Selection.Delete Shift:=xlUp
    Rows("1:2").Select
    Range("A2").Activate
    Selection.Delete Shift:=xlUp
    Range("A1").Select
    Selection.Font.Bold = True
    Range("A1:E1").Select
    With Selection
        .HorizontalAlignment = xlCenterAcrossSelection
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    ActiveCell.FormulaR1C1 = "Quotas on EUFRHQFS01WP"
    Rows("3:3").Select
    Selection.Font.Bold = True
    Columns("A:A").EntireColumn.AutoFit
    Columns("B:B").EntireColumn.AutoFit
    Columns("C:C").EntireColumn.AutoFit
    Columns("D:D").EntireColumn.AutoFit
    Columns("E:E").EntireColumn.AutoFit
    Columns("E:E").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.FormatConditions.Delete
    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, _
        Formula1:="99,5", Formula2:="99,9"
    With Selection.FormatConditions(1).Font
        .Bold = True
        .Italic = False
        .ColorIndex = 46
    End With
    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, _
        Formula1:="99,9"
    With Selection.FormatConditions(2).Font
        .Bold = True
        .Italic = False
        .ColorIndex = 3
    End With
    Range("E3").Select
    Selection.Font.ColorIndex = 0
    With Selection.Font
        .Name = "Arial"
        .FontStyle = "Gras"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 1
    End With
        Columns("E:E").Select
    Selection.TextToColumns Destination:=Range("E1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
 
        Range("A2").Select
 
ActiveWorkbook.Save
 
 
 
 
 
    On Error Resume Next
 
 
    Dim Maildb As Object 'The mail database
    Dim UserName As String 'The current users notes name
    Dim MailDbName As String 'THe current users notes mail database name
    Dim MailDoc As Object 'The mail document itself
    Dim AttachME As Object 'The attachment richtextfile object
    Dim Session As Object 'The notes session
    Dim EmbedObj As Object 'The embedded object (Attachment)
    Dim dest As String
    Dim monTab() As String
    Dim newname As String
 
    Set Session = CreateObject("Notes.NotesSession")
    UserName = Session.UserName
    MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
    'Open the mail database in notes
    Set Maildb = Session.GetDatabase("", MailDbName)
     If Maildb.IsOpen = True Then
          'Already open for mail
     Else
 
     Maildb.OPENMAIL
 
     End If
    'Set up the new mail document
    Set MailDoc = Maildb.CreateDocument
    MailDoc.Form = "Memo"
    MailDoc.Subject = "Envoi Automatique Alerte Quota FS01"
    MailDoc.body = "Alerte de Quota sur FS01"
    MailDoc.SAVEMESSAGEONSEND = saveit
 
        Sheets("Parms").Range("A1") = 0
    newname = "C:\Quota Alerte Mail.xls"
    ThisWorkbook.SaveCopyAs Filename:=newname
    Sheets("Parms").Range("A1") = 1
    Attachment = newname
 
 
      If Attachment <> "" Then
        Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment")
        Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", Attachment, "Attachment")
        MailDoc.CREATERICHTEXTITEM ("Attachment")
    End If
 
 
 
    'Send the document
    dest = Sheets("MACRO").Range("A1") & ", " & Sheets("MACRO").Range("A2")
    monTab = Split(dest, ",")
    MailDoc.Send 0, monTab()
    MailDoc.PostedDate = Now()
 
    'Clean Up
    Set Maildb = Nothing
    Set MailDoc = Nothing
    Set AttachME = Nothing
    Set Session = Nothing
    Set EmbedObj = Nothing
 
 
 
 
    Excel.Application.Quit
    Application.DisplayAlerts = False
 
    End Sub

**mattwarend** · 18/11/2008, 13h45

C'est parfait !
Merci ! Merci !!!
J'essai de comprendre et d'ailleurs j'ai bcp appris depuis que je me suis mis aux macros, cad, depuis 3 semaines...

En fait, maintenant, je voudrais faire en sorte que lorsque une valeur de la colonne E est supérieur à 99,5, d'envoyer le mail, sinon, de ne rien faire.
Ca me parait pas évident puisque pour que les valeurs de la colonne E soit reconnu en nombre, je dois d'abord convertir et ensuite appliquer le format nombre.
Tu m'avais indiqué d'appliquer ceci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub Call_send_mail()
Dim result As Boolean
result = True
With Sheets(Activesheet)
For Each cell In .Range(Range("E65536").End(xlUp), Range("E1"))
 If cell.Value < 99.5 Then
    result = False
 End If
Next
End With
if result then 
  Sendmail
endif
 
 
End Sub

J'ai fait plusieurs essai mais je pense que le problème vient du fait que lorsque je fais le

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If cell.Value < 99.5 Then

les données de la colonne E ne sont pas encore transformées...

**Godzestla** · 18/11/2008, 14h29

Re,

pour ton info ce n'est pas ceci que tu avais demande

En fait, maintenant, je voudrais faire en sorte que lorsque une valeur de la colonne E est supérieur à 99,5, d'envoyer le mail, sinon, de ne rien faire.

mais ceci, et ce n'est pas la même chose

ne pas envoyer de mail si une valeur de la colonne E est < 99,5

la qualité de la réponse dépend de la qualité de la question !!!!

Donc il te faudrais plutot ceci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
 
Sub auto_open()
    Dim Msg, Style, Title, Help, Ctxt, Response, MyString
    Dim result As Boolean
    If Sheets("Parms").Range("A1") = 1 Then
         send_email
    End If
End Sub
Sub send_email()
        Dim result As Boolean
 
        Cells.Select
        Selection.ClearContents
        Range("A1").Select
 
 
 
        'ChDir "C:\Documents and Settings\admincot\Desktop"
        Workbooks.OpenText Filename:="C:\DATA\Test\testexcel\Usage.txt", Origin:= _
            xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote _
            , ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=True, Comma:= _
            False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), _
            TrailingMinusNumbers:=True
        Cells.Select
        Selection.Copy
        Windows("Classeur1.xls").Activate
        ActiveSheet.Paste
        Columns("E:E").Select
        Selection.Replace What:=".", Replacement:=",", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
        Application.CutCopyMode = False
            With Selection
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlBottom
            .WrapText = False
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
            End With
        Selection.NumberFormat = "0.00"
 
        result = False
        With ActiveSheet
            For Each cell In .Range(Range("E65536").End(xlUp), Range("E5"))
                If cell.Value > 99.5 Then
                    result = True
                    Exit For
                End If
            Next
        End With
 
 
        Rows("8:8").Select
        Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
        Selection.Sort Key1:=Range("E8"), Order1:=xlDescending, Header:=xlGuess, _
           OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
         DataOption1:=xlSortNormal
        Selection.AutoFilter
        Selection.AutoFilter Field:=5, Criteria1:=">99,5", Operator:=xlAnd
        Range("A6").Select
        Selection.TextToColumns Destination:=Range("A6"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
            Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
            :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), _
            TrailingMinusNumbers:=True
        Rows("4:4").Select
    Selection.Delete Shift:=xlUp
    Rows("1:2").Select
    Range("A2").Activate
    Selection.Delete Shift:=xlUp
    Range("A1").Select
    Selection.Font.Bold = True
    Range("A1:E1").Select
    With Selection
        .HorizontalAlignment = xlCenterAcrossSelection
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    ActiveCell.FormulaR1C1 = "Quotas on EUFRHQFS01WP"
    Rows("3:3").Select
    Selection.Font.Bold = True
    Columns("A:A").EntireColumn.AutoFit
    Columns("B:B").EntireColumn.AutoFit
    Columns("C:C").EntireColumn.AutoFit
    Columns("D:D").EntireColumn.AutoFit
    Columns("E:E").EntireColumn.AutoFit
    Columns("E:E").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.FormatConditions.Delete
    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, _
        Formula1:="99,5", Formula2:="99,9"
    With Selection.FormatConditions(1).Font
        .Bold = True
        .Italic = False
        .ColorIndex = 46
    End With
    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, _
        Formula1:="99,9"
    With Selection.FormatConditions(2).Font
        .Bold = True
        .Italic = False
        .ColorIndex = 3
    End With
    Range("E3").Select
    Selection.Font.ColorIndex = 0
    With Selection.Font
        .Name = "Arial"
        .FontStyle = "Gras"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 1
    End With
        Columns("E:E").Select
    Selection.TextToColumns Destination:=Range("E1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
 
        Range("A2").Select
 
ActiveWorkbook.Save
 
 
 
 
 
    On Error Resume Next
 
 
    Dim Maildb As Object 'The mail database
    Dim UserName As String 'The current users notes name
    Dim MailDbName As String 'THe current users notes mail database name
    Dim MailDoc As Object 'The mail document itself
    Dim AttachME As Object 'The attachment richtextfile object
    Dim Session As Object 'The notes session
    Dim EmbedObj As Object 'The embedded object (Attachment)
    Dim dest As String
    Dim monTab() As String
    Dim newname As String
 
 
     If result Then
        Msg = "Usage > 99,5. Do you want to Send the Mail ?"    ' Define message.
        Style = vbYesNo + vbCritical + vbDefaultButton2    ' Define buttons.
        Title = "MsgBox Send"    ' Define title.
        Help = "DEMO.HLP"    ' Define Help file.
        Ctxt = 1000    ' Define topic
        ' context.
        ' Display message.
        Response = MsgBox(Msg, Style, Title, Help, Ctxt)    'METTRE EN COMMENTAIRE
        If Response = vbNo Then    ' User chose No          'METTRE EN COMMENTAIRE
                Exit Sub
        End If                                              'METTRE EN COMMENTAIRE
      Else
        Exit Sub
     End If
 
    Set Session = CreateObject("Notes.NotesSession")
    UserName = Session.UserName
    MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
    'Open the mail database in notes
    Set Maildb = Session.GetDatabase("", MailDbName)
     If Maildb.IsOpen = True Then
          'Already open for mail
     Else
 
     Maildb.OPENMAIL
 
     End If
    'Set up the new mail document
    Set MailDoc = Maildb.CreateDocument
    MailDoc.Form = "Memo"
    MailDoc.Subject = "Envoi Automatique Alerte Quota FS01"
    MailDoc.body = "Alerte de Quota sur FS01"
    MailDoc.SAVEMESSAGEONSEND = saveit
 
        Sheets("Parms").Range("A1") = 0
    newname = "C:\Quota Alerte Mail.xls"
    ThisWorkbook.SaveCopyAs Filename:=newname
    Sheets("Parms").Range("A1") = 1
    Attachment = newname
 
 
      If Attachment <> "" Then
        Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment")
        Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", Attachment, "Attachment")
        MailDoc.CREATERICHTEXTITEM ("Attachment")
    End If
 
 
 
    'Send the document
    dest = Sheets("MACRO").Range("A1") & ", " & Sheets("MACRO").Range("A2")
    monTab = Split(dest, ",")
    MailDoc.Send 0, monTab()
    MailDoc.PostedDate = Now()
 
    'Clean Up
    Set Maildb = Nothing
    Set MailDoc = Nothing
    Set AttachME = Nothing
    Set Session = Nothing
    Set EmbedObj = Nothing
 
 
 
 
    Excel.Application.Quit
    Application.DisplayAlerts = False
 
    End Sub

**mattwarend** · 18/11/2008, 14h56

J'ai modifié ton code pour ne plus avoir à valider pour que le message soit envoyé (ne plus voir la MSG Box)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
 If result Then
        Msg = "Usage > 99,5. Do you want to Send the Mail ?"    ' Define message.
        Style = vbYesNo + vbCritical + vbDefaultButton2    ' Define buttons.
        Title = "MsgBox Send"    ' Define title.
        Help = "DEMO.HLP"    ' Define Help file.
        Ctxt = 1000    ' Define topic
        ' context.
        ' Display message.
        'Response = MsgBox(Msg, Style, Title, Help, Ctxt)    'METTRE EN COMMENTAIRE
        'If Response = vbNo Then    ' User chose No          'METTRE EN COMMENTAIRE
                Exit Sub
        'End If                                              'METTRE EN COMMENTAIRE
      Else
        Exit Sub
     End If

Et du coup, le message ne s'envoi plus...

Je suis définitivement pas bon en macro...

Mais je vais m'entrainer (bcp !!)

**Godzestla** · 18/11/2008, 15h02

C'est parce que il y a

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Exit Sub

qui est le code pour arreter la procédure (qui tombait dans le cas ou on répondais No à la question).

Mets tout le bloc que tu montre en commentaire ou elnève-le?
Cela devrait fonctionner.

Enfin j'espère.......