Bonjour
j'aimerai générer un mail automatique si la date est dépassé.
J'ai mis le code VBA suivant (voir bas discussion)
Je voudrais que cela prenne en compte uniquement les adresse mail dans ma feuille et que la cible soit un dépassement de date ou si retard envoie de mail.
Je voudrait que le mail soit la feuil mail directement
Je sais que je demande surement l'impossible mais comme les meilleurs sont ici je tante lol.
Merci
'Update by Extendoffice 2018/3/7
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Cells.Count > 1 Then Exit Sub
Set xRg = Intersect(Range("j9"), Target)
If xRg Is Nothing Then Exit Sub
If IsDate(Target.Value) And Target.Value < h9 Then
Call Mail_small_Text_Outlook
End If
End Sub
Sub Mail_small_Text_Outlook()
Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
xMailBody = "Bonjour, suite a votre intervention sur notre site vous nous avait pas restituer la clefs merci de nous la retourner au plus vite" & vbNewLine & vbNewLine & _
"This is line 1" & vbNewLine & _
"This is line 2"
On Error Resume Next
With xOutMail
.To = "Email Address"
.CC = ""
.BCC = ""
.Subject = "send by cell value test"
.Body = xMailBody
.Display 'or use .Send
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub
'
j'aimerai générer un mail automatique si la date est dépassé.
J'ai mis le code VBA suivant (voir bas discussion)
Je voudrais que cela prenne en compte uniquement les adresse mail dans ma feuille et que la cible soit un dépassement de date ou si retard envoie de mail.
Je voudrait que le mail soit la feuil mail directement
Je sais que je demande surement l'impossible mais comme les meilleurs sont ici je tante lol.
Merci
'Update by Extendoffice 2018/3/7
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Cells.Count > 1 Then Exit Sub
Set xRg = Intersect(Range("j9"), Target)
If xRg Is Nothing Then Exit Sub
If IsDate(Target.Value) And Target.Value < h9 Then
Call Mail_small_Text_Outlook
End If
End Sub
Sub Mail_small_Text_Outlook()
Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
xMailBody = "Bonjour, suite a votre intervention sur notre site vous nous avait pas restituer la clefs merci de nous la retourner au plus vite" & vbNewLine & vbNewLine & _
"This is line 1" & vbNewLine & _
"This is line 2"
On Error Resume Next
With xOutMail
.To = "Email Address"
.CC = ""
.BCC = ""
.Subject = "send by cell value test"
.Body = xMailBody
.Display 'or use .Send
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub
'
