Lỗi gửi mail tự động qua outlook

[Emily251199]

Lần đầu mail người nhận hiển thị đúng nội dung cần gửi nhưng các lần sau đó mail nhận được bị lỗi như thế này. Em nhờ các ac giúp ạ.


Macro gửi mail tự động qua outlook
Sub Gui_Mail_Ket_Qua_Cap_Do_Lean()

Dim OutlookApp As Outlook.Application
Dim OutlookMail As Outlook.MailItem

If Sheet1.Range("A9").Value = "" Then
MsgBox "Khong co Email can gui", 48 + 0, "Gui Mail Bao Cao"
Exit Sub

Else
Dim i As Long
For i = 14 To Sheet1.Range("A9").Value + 13
Sheet1.Range("D3").Value = Sheet1.Range("D" & i).Value

Set OutlookApp = New Outlook.Application
Set OutlookMail = OutlookApp.CreateItem(olMailItem)
With OutlookMail
.BodyFormat = olFormatHTML
.display
.HTMLBody = Sheet1.Range("D7").Value & "<br>" & "<br>" & Sheet1.Range("D8").Value & "<br>" & "<br>" & Sheet1.Range("D9").Value & "<br>" & Sheet1.Range("D10").Value & .HTMLBody
.To = Sheet1.Range("D4").Value
.CC = Sheet1.Range("D5").Value
.Subject = Sheet1.Range("D6").Value

If Sheet1.Range("D11").Value <> "" Then
OutlookMail.Attachments.Add Sheet1.Range("D11").Value
End If

.send
Application.Wait (Now + TimeValue("0:00:02"))
Application.SendKeys "%s"
End With
Set OutlookApp = Nothing
Set OutlookMail = Nothing

Next
End If
MsgBox "Hoan thanh gui Mail Ket qua Cap do Lean"
Exit Sub
End Sub

 

[snow25]

Lần đầu mail người nhận hiển thị đúng nội dung cần gửi nhưng các lần sau đó mail nhận được bị lỗi như thế này. Em nhờ các ac giúp ạ.
View attachment 282314

Macro gửi mail tự động qua outlook
Sub Gui_Mail_Ket_Qua_Cap_Do_Lean()

Dim OutlookApp As Outlook.Application
Dim OutlookMail As Outlook.MailItem

If Sheet1.Range("A9").Value = "" Then
MsgBox "Khong co Email can gui", 48 + 0, "Gui Mail Bao Cao"
Exit Sub

Else
Dim i As Long
For i = 14 To Sheet1.Range("A9").Value + 13
Sheet1.Range("D3").Value = Sheet1.Range("D" & i).Value

Set OutlookApp = New Outlook.Application
Set OutlookMail = OutlookApp.CreateItem(olMailItem)
With OutlookMail
.BodyFormat = olFormatHTML
.display
.HTMLBody = Sheet1.Range("D7").Value & "<br>" & "<br>" & Sheet1.Range("D8").Value & "<br>" & "<br>" & Sheet1.Range("D9").Value & "<br>" & Sheet1.Range("D10").Value & .HTMLBody
.To = Sheet1.Range("D4").Value
.CC = Sheet1.Range("D5").Value
.Subject = Sheet1.Range("D6").Value

If Sheet1.Range("D11").Value <> "" Then
OutlookMail.Attachments.Add Sheet1.Range("D11").Value
End If

.send
Application.Wait (Now + TimeValue("0:00:02"))
Application.SendKeys "%s"
End With
Set OutlookApp = Nothing
Set OutlookMail = Nothing

Next
End If
MsgBox "Hoan thanh gui Mail Ket qua Cap do Lean"
Exit Sub
End Sub

Sao ở chỗ đầu gán range("d3") làm gì vậy ta thay bằng thằng,D4 xem sao.