VBA code to show email sent status in coulmn

[SRL]

Hi,

I need VBA code to show email sent status in one column of excel

please help me to add this code in my below mentioned existing code

Sub SendCustEmails()

Dim ObjOutlook As Object
Set ObjOutlook = CreateObject("Outlook.Application")
Dim ObjEmail As Object

intRow = 2
strEmployeeID = ThisWorkbook.Sheets("Employee Details").Range("A" & intRow).Text

While (strEmployeeID <> "")
Set ObjEmail = ObjOutlook.CreateItem(olMailItem)
strMailSubject = ThisWorkbook.Sheets("Mail Details").Range("A2").Text
strMailBody = ThisWorkbook.Sheets("Mail Details").Range("B2").Text
strMonth = ThisWorkbook.Sheets("Mail Details").Range("C2").Text

strFolder = "D:\Payslip\AUG 2022\QG\A\PAYSLIP"
strEmployeeID = ThisWorkbook.Sheets("Employee Details").Range("A" & intRow).Text
strEmployeeName = ThisWorkbook.Sheets("Employee Details").Range("B" & intRow).Text
strEmailID = ThisWorkbook.Sheets("Employee Details").Range("C" & intRow).Text
strFileName = ThisWorkbook.Sheets("Employee Details").Range("D" & intRow).Text

strMailSubject = Replace(strMailSubject, "<Employee ID>", strEmployeeID)
strMailBody = Replace(strMailBody, "<Employee Name>", strEmployeeName)
strMailBody = Replace(strMailBody, "<Month>", strMonth)

With ObjEmail
.To = CStr(strEmailID)
.Subject = strMailSubject
.Body = strMailBody
.Attachments.Add strFolder & "\" & strFileName
.Send
End With
intRow = intRow + 1
strEmployeeID = ThisWorkbook.Sheets("Employee Details").Range("A" & intRow).Text
Wend
MsgBox "Emails Sending Completed"
End Sub

 

[portews]

Try this:

After the

End With

(assuming that D column is where the Email Status is), put:

 ThisWorkbook.Sheets("Mail Details").Range("D"& intRow)="Sent"