ExcelNewbie96
XLDnaute Nouveau
Bonjour,
Je suis actuellement d'écrire un code afin de pouvoir rédiger un mail automatiquement et les afficher avant de les envoyer.
Code:
Sub SendEmail_Example1()
Dim EmailApp As Outlook.Application
Dim Source As String
Set EmailApp = New Outlook.Application
Dim EmailItem As Outlook.MailItem
Set EmailItem = EmailApp.CreateItem(olMailItem)
Dim i As Long, lastrow As Long
Dim Cell As Range
lastrow = Cells(Rows.Count, "C").End(xlDown).Row
For Each Cell In Cells(Rows.Count, "M")
If Cells.Value = "YES" Then
EmailItem.To = Range("K").Text
EmailItem.Subject = "Reminder missing element for project " & Cells(i, 5).Text
EmailItem.HTMLBody = Cells(i, 13).Text
EmailItem.Display
End If
Next Cell
End Sub
Le problème est que le code bloque au niveau de la ligne en orange. Le message d'erreur indique "mémoire insuffisante". Quelqu'un aurait une solution à me proposer je vous prie ?
En vous remerciant !!
Je suis actuellement d'écrire un code afin de pouvoir rédiger un mail automatiquement et les afficher avant de les envoyer.
Code:
Sub SendEmail_Example1()
Dim EmailApp As Outlook.Application
Dim Source As String
Set EmailApp = New Outlook.Application
Dim EmailItem As Outlook.MailItem
Set EmailItem = EmailApp.CreateItem(olMailItem)
Dim i As Long, lastrow As Long
Dim Cell As Range
lastrow = Cells(Rows.Count, "C").End(xlDown).Row
For Each Cell In Cells(Rows.Count, "M")
If Cells.Value = "YES" Then
EmailItem.To = Range("K").Text
EmailItem.Subject = "Reminder missing element for project " & Cells(i, 5).Text
EmailItem.HTMLBody = Cells(i, 13).Text
EmailItem.Display
End If
Next Cell
End Sub
Le problème est que le code bloque au niveau de la ligne en orange. Le message d'erreur indique "mémoire insuffisante". Quelqu'un aurait une solution à me proposer je vous prie ?
En vous remerciant !!