Envoyer un mail via VBA

Le 05/11/2015 à 11:59

Bonjour à tous

J'ai un fichier excel qui me permet d'enregistrer des valeurs de productions ainsi d'avoir un suivit précis des pièces que l'on fabrique .

Toutes les valeurs enregistrées sont soumises à des mises en formes ( OK / NOK ) qui permettent aux opérateurs d'être alerté visuellement en cas de non conformités , mais l'enregistrement est quand même possible ( volontairement ) .

Ma question est simple : comment est-il possible d'être alerté par mail en cas de valeurs non conformes ?

Je m'explique : l'opérateur entre sa valeur ( comprise entre 0 et 4 ) OK , l'enregistrement se fait normalement

l'opérateur entre sa valeur ( à partir de 4.01 ) NOK , l'enregistrement se fait mais en parallèle je reçois un mail qui m'indique une non-conformité .

Est -il possible de réaliser cette opération et si oui , comment ?

Merci par avance de votre aide

Le 05/11/2015 à 12:53

Bonjour avec cette macro où il faut adapter tout ce qu'il y a de surligner en vert. L'élément principale se passe en ligne deux où la macro cherche la plus grande valeur et si elle est supérieur à 4 la procédure d'envoi d'email s'applique.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If Application.WorksheetFunction.Max(Feuil1.[a:a]) > 4 Then
Dim OutApp As Object, Outmail As Object
Dim quoi As String, qui As String

Set OutApp = CreateObject("outlook.application")
Set Outmail = OutApp.createitem(0)

quoi = "Alerte automatique dépassement de valeur"
qui = "blabla@blabla.fr"

On Error Resume Next
With Outmail
.To = qui
.CC = ""
.BCC = ""
.Subject ="Valeur dépassée"
.body = quoi
'.attachements.add ("C:\test.txt")
.send
End With
On Error GoTo 0
Set Outmail = Nothing
Set OutApp = Nothing
End If
End Sub

Le 05/11/2015 à 13:53

Merci beaucoup .

De ce que je comprend de ce code , il cherche toutes les valeurs > 4 , sauf que moi dans un premier temps je ne cible qu'une seule cellule .

Ensuite j'ai fais plusieurs essais pour coller ce code dans une feuille mais il ne semble pas se déclencher , j'ai essayé sur la feuille source ( nommé PT dans mon fichier , et sur le module1 ( là où est enregistré la macro de sauvegarde ) mais ça ne fonctionne pas ....

Désolé mais je suis un peu une quiche pour VBA

Merci

Le 05/11/2015 à 14:20

Joignez un fichier s'il vous plait parce qu'il y a des nuances dans vos propos (dans l’énoncé vous ne précisez pas quelles sont les cellules à observer et vous dites juste "les cellules" et maintenant il n'y a qu'une seule cellule à surveiller...) Comprenez que pour une aide pertinente, il faut que le problème le soit

P.S le code n'est pas à coller dans un module mais dans le feuille this workbook

Cordialement

Le 05/11/2015 à 14:43

Oui ok désolé

Je vais joindre le fichier et expliquer un peu plus précisément ce que je veux:

59pt-four.xlsx (86.35 Ko)

Donc voilà ( le fichier étant trop lourd je n'ai mis que la page qui nous intéresse et je copierais le code après ) :

Concrètement les opérateurs remplissent le fichier au niveau de la colonne "M" .

La cellule M18 est la différence entre M16 et M17 .

C'est sur M18 que je veux me focaliser .

Si M18 est supérieur à 4 , c'est au moment où l'opérateur appuiera sur le bouton "enregistrer" que je veux recevoir le mail d'alerte .

Voilà comment se passe l'enregistrement :

Sub Bouton164_QuandClic()

Dim ligne As Long

ligne = ThisWorkbook.Worksheets("Liste").Range("A65536").End(xlUp).Row + 1

'test si cellule vide + mesgbox

If (Cells(4, 13) = Empty) Then MsgBox "Renseigner cellule : INITIALES OPERATEURS"

If (Cells(5, 13) = "Scanner code barre de la ZK12") Or (Cells(5, 14) = Empty) Then MsgBox "Renseigner cellule : REFERENCE"

If (Cells(6, 13) = Empty) Then MsgBox "Renseigner cellule : TYPE DE PIECE TYPE"

'test si cellule = NOK + msgbox pour définir le mode de réaction

'If (Cells(8, 13) = "NOK") Or (Cells(10, 11) = "NOK") Or (Cells(11, 11) = "NOK") Or (Cells(12, 11) = "NOK") Or (Cells(13, 11) = "NOK") Or (Cells(14, 11) = "NOK") Or (Cells(15, 11) = "NOK") Or (Cells(18, 11) = "NOK") Or (Cells(21, 11) = "NOK") Or (Cells(22, 11) = "NOK") Or (Cells(27, 11) = "NOK") Or (Cells(30, 11) = "NOK") Or (Cells(31, 11) = "NOK") Or (Cells(32, 11) = "NOK") Or (Cells(33, 11) = "NOK") Or (Cells(34, 11) = "NOK") Or (Cells(35, 11) = "NOK") Or (Cells(36, 11) = "NOK") Or (Cells(39, 11) = "NOK") Or (Cells(41, 11) = "NOK") Or (Cells(42, 11) = "NOK") Or (Cells(43, 11) = "NOK") Or (Cells(44, 11) = "NOK") Then UserForm1.Show

'test si cellule non vide et oubli scan étiquette UVC alors exécution de plusieurs opérations

If (Cells(4, 13) = Empty) Then GoTo saut2

If (Cells(5, 13) = "Sélectionner la référence") Or (Cells(5, 13) = Empty) Then GoTo saut2

'If (Cells(6, 13) = Empty) Then GoTo saut2

saut1:

Call sauvegarde

saut2:

End Sub

Sub sauvegarde()

Dim ligne As Long

ligne = ThisWorkbook.Worksheets("Liste").Range("A65536").End(xlUp).Row + 1

ThisWorkbook.Worksheets("Liste").Range("A" & ligne).Value = ThisWorkbook.Worksheets("PT").Range("m3").Value

ThisWorkbook.Worksheets("Liste").Range("B" & ligne).Value = ThisWorkbook.Worksheets("PT").Range("m4").Value

ThisWorkbook.Worksheets("Liste").Range("C" & ligne).Value = ThisWorkbook.Worksheets("PT").Range("m5").Value

ThisWorkbook.Worksheets("Liste").Range("D" & ligne).Value = ThisWorkbook.Worksheets("PT").Range("m6").Value

If Not ThisWorkbook.Worksheets("PT").Range("m8").Value = "" Then ThisWorkbook.Worksheets("Liste").Range("E" & ligne).Value = ThisWorkbook.Worksheets("PT").Range("m8").Value

If Not ThisWorkbook.Worksheets("PT").Range("m9").Value = "" Then ThisWorkbook.Worksheets("Liste").Range("F" & ligne).Value = ThisWorkbook.Worksheets("PT").Range("m9").Value

If Not ThisWorkbook.Worksheets("PT").Range("m10").Value = "" Then ThisWorkbook.Worksheets("Liste").Range("G" & ligne).Value = ThisWorkbook.Worksheets("PT").Range("m10").Value

If Not ThisWorkbook.Worksheets("PT").Range("m11").Value = "" Then ThisWorkbook.Worksheets("Liste").Range("H" & ligne).Value = ThisWorkbook.Worksheets("PT").Range("m11").Value

If Not ThisWorkbook.Worksheets("PT").Range("m12").Value = "" Then ThisWorkbook.Worksheets("Liste").Range("I" & ligne).Value = ThisWorkbook.Worksheets("PT").Range("m12").Value

If Not ThisWorkbook.Worksheets("PT").Range("m13").Value = "" Then ThisWorkbook.Worksheets("Liste").Range("J" & ligne).Value = ThisWorkbook.Worksheets("PT").Range("m13").Value

If Not ThisWorkbook.Worksheets("PT").Range("m14").Value = "" Then ThisWorkbook.Worksheets("Liste").Range("K" & ligne).Value = ThisWorkbook.Worksheets("PT").Range("m14").Value

If Not ThisWorkbook.Worksheets("PT").Range("m15").Value = "" Then ThisWorkbook.Worksheets("Liste").Range("L" & ligne).Value = ThisWorkbook.Worksheets("PT").Range("m15").Value

If Not ThisWorkbook.Worksheets("PT").Range("m16").Value = "" Then ThisWorkbook.Worksheets("Liste").Range("M" & ligne).Value = ThisWorkbook.Worksheets("PT").Range("m16").Value

If Not ThisWorkbook.Worksheets("PT").Range("m17").Value = "" Then ThisWorkbook.Worksheets("Liste").Range("N" & ligne).Value = ThisWorkbook.Worksheets("PT").Range("m17").Value

If Not ThisWorkbook.Worksheets("PT").Range("m18").Value = "" Then ThisWorkbook.Worksheets("Liste").Range("O" & ligne).Value = ThisWorkbook.Worksheets("PT").Range("m18").Value

If Not ThisWorkbook.Worksheets("PT").Range("m19").Value = "" Then ThisWorkbook.Worksheets("Liste").Range("P" & ligne).Value = ThisWorkbook.Worksheets("PT").Range("m19").Value

If Not ThisWorkbook.Worksheets("PT").Range("m20").Value = "" Then ThisWorkbook.Worksheets("Liste").Range("Q" & ligne).Value = ThisWorkbook.Worksheets("PT").Range("m20").Value

If Not ThisWorkbook.Worksheets("PT").Range("m21").Value = "" Then ThisWorkbook.Worksheets("Liste").Range("R" & ligne).Value = ThisWorkbook.Worksheets("PT").Range("m21").Value

If Not ThisWorkbook.Worksheets("PT").Range("m22").Value = "" Then ThisWorkbook.Worksheets("Liste").Range("S" & ligne).Value = ThisWorkbook.Worksheets("PT").Range("m22").Value

If Not ThisWorkbook.Worksheets("PT").Range("m23").Value = "" Then ThisWorkbook.Worksheets("Liste").Range("T" & ligne).Value = ThisWorkbook.Worksheets("PT").Range("m23").Value

If Not ThisWorkbook.Worksheets("PT").Range("m24").Value = "" Then ThisWorkbook.Worksheets("Liste").Range("U" & ligne).Value = ThisWorkbook.Worksheets("PT").Range("m24").Value

If Not ThisWorkbook.Worksheets("PT").Range("m25").Value = "" Then ThisWorkbook.Worksheets("Liste").Range("V" & ligne).Value = ThisWorkbook.Worksheets("PT").Range("m25").Value

ThisWorkbook.Worksheets("PT").Range("m4").Value = ""

ThisWorkbook.Worksheets("PT").Range("m5").Value = "Sélectionner la référence"

ThisWorkbook.Worksheets("PT").Range("m6").Value = ""

ThisWorkbook.Worksheets("PT").Range("m8").Value = "Numéro"

ThisWorkbook.Worksheets("PT").Range("m9").Value = "Numéro"

ThisWorkbook.Worksheets("PT").Range("m10").Value = "Noter la lettre"

ThisWorkbook.Worksheets("PT").Range("m11").Value = "Entrer valeur"

ThisWorkbook.Worksheets("PT").Range("m12").Value = "OK/NOK"

ThisWorkbook.Worksheets("PT").Range("m13").Value = "OK/NOK"

ThisWorkbook.Worksheets("PT").Range("m14").Value = "OK/NOK"

ThisWorkbook.Worksheets("PT").Range("m15").Value = "OK/NOK"

ThisWorkbook.Worksheets("PT").Range("m19").Value = "Entrer valeur"

ThisWorkbook.Worksheets("PT").Range("m20").Value = "Entrer Valeur"

ThisWorkbook.Worksheets("PT").Range("m21").Value = "Entrer Valeur"

ThisWorkbook.Worksheets("PT").Range("m22").Value = "Entrer Valeur"

ThisWorkbook.Worksheets("PT").Range("m23").Value = "Entrer Valeur"

ThisWorkbook.Worksheets("PT").Range("m24").Value = "Entrer Valeur"

ThisWorkbook.Worksheets("PT").Range("m25").Value = "N° DE DEROG si applicable"

'ThisWorkbook.Worksheets("PT").Range("ac16").Value = "=(AB8+AB9+AB10)/3"'

'ThisWorkbook.Worksheets("PT").Range("ac17").Value = "=(AC8+AC9+AC10)/3"'

'ThisWorkbook.Worksheets("PT").Range("m16").Value = "=ac15-am8"'

'ThisWorkbook.Worksheets("PT").Range("m17").Value = "=ac16-am12"'

'ThisWorkbook.Worksheets("PT").Range("m18").Value = "=m15-m16"'

ActiveWindow.SmallScroll Down:=-3

Range("AB8:AC10").Select

Selection.ClearContents

ActiveWorkbook.Save

UserForm2.Show

End Sub

Vous voyez apparaître mais comme je l'ai expliqué le fichier est trop lourd donc je n'ai pas pu tout mettre .

J’espère que je suis un peu plus clair

Le 05/11/2015 à 15:12

Si dans M18 il y a une valeur numérique. Le code est à placer dans le code du bouton164 avant ou après saut1 ou saut2 je ne sais pas.

If Feuil1.[M18] > 4 Then
Dim OutApp As Object, Outmail As Object
Dim quoi As String, qui As String

Set OutApp = CreateObject("outlook.application")
Set Outmail = OutApp.createitem(0)

quoi = "Alerte automatique dépassement de valeur"
qui = "blabla@blabla.fr"

On Error Resume Next
With Outmail
.To = qui
.CC = ""
.BCC = ""
.Subject ="Valeur dépassée"
.body = quoi
'.attachements.add ("C:\test.txt")
.send
End With
On Error GoTo 0
Set Outmail = Nothing
Set OutApp = Nothing
End If

Le 05/11/2015 à 15:51

Cool , merci

Il a commencé à lire la macro mais se bloque sur la partie : Set OutApp = CreateObject("outlook.application")

Je pense que ça doit venir de notre serveur de mail ?????

Pour info , nous utilisons GMAIL

Le 05/11/2015 à 17:11

Ben si vous n'avez pas outlook comme logiciel de messagerie normal que cela ne fonctionne pas.

Le 06/11/2015 à 07:50

Oui je saisie bien , mais n'y a t-il pas dans ce cas un autre moyen de réaliser cette action ?

Le 06/11/2015 à 09:52

Si vous n'utilisez pas de logiciel de messagerie et que vous envoyez vos email directement depuis l'interface de google...Rapprochez-vous d'eux ou d'un forum traitant de se sujet car pour ma part, je ne suis pas du tout compétent.

Le 06/11/2015 à 10:14

Ok ça marche

En tout cas , merci beaucoup pour votre aide

Le 24/11/2015 à 14:20

Bonjour

Merci pour toute ces réponses .

Après demande auprès de notre service informatique , ils m'ont confirmé que nous ne pouvions pas envoyer de mail via excel ( serveur trop protégé ) .

Ce qui m'amène à chercher une autre solution à savoir :

Vba peut-il fonctionner en prenant une couleur de cellule comme condition ?
Mon fichier est plein de cellule avec des couleurs selon les données que les opérateurs entrent : vert OK rouge NOK .

Au moment de l'enregistrement ( bouton avec un code ) je voudrais avoir un userform qui s'affiche lorsque que j'essaye d'enregistrer un valeur NOK ( cellule rouge ) .

Merci d'avance

Rechercher des sujets similaires à "envoyer mail via vba"