VBA to email pay slip

[tayomi]

I maintain payroll on Excel. The workbook contains different sheets one of which is named PAYSLIP.
The payslip was populated through data validation list and combination of IF and VLookup formula. Such that if a staff name is selected from the cell that contains data validation list all the fields will be filled automatically. Payslip had been set as Print_Area

VBA code was written to attach Print_Area as PDF, loop through the data validation list and email everyone on the list a custom payslip.
Below was the VBA applied.

Sub EmailPayslipToDataValidationList()
On Error GoTo ErrorHandler

Dim ws As Worksheet
Dim rngDataValidation As Range
Dim cell As Range
Dim OutlookApp As Object
Dim OutlookMail As Object
Dim payslip As String

' Set the worksheet and range containing the data validation list
Set ws = ThisWorkbook.Worksheets("PAYSLIP") ' Replace "Sheet1" with your actual worksheet name
Set rngDataValidation = ws.Range("J5:J54") ' Replace A1:A10 with the range containing your data validation list

' Create Outlook objects
Set OutlookApp = CreateObject("Outlook.Application")

' Loop through each cell in the data validation list
For Each cell In rngDataValidation
' Skip empty cells and header row
If Not IsEmpty(cell) And cell.Row <> 1 Then
' Set the print area based on the cell's row
ws.PageSetup.PrintArea = ws.Range("B2:F16" & cell.Row).CurrentRegion.Address

' Create a temporary PDF file name
payslip = Environ("TEMP") & "\" & "Payslip.pdf"

' Export the print area as PDF
ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:=payslip, Quality:=xlQualityStandard

' Create a new email
Set OutlookMail = OutlookApp.CreateItem(0)

' Set email properties
With OutlookMail
.Subject = "Payslip"
.Body = "Please find attached your payslip."
.To = cell.Value ' Assumes the email addresses are in the same column as the data validation list
.Attachments.Add payslip
.Send
End With

' Delete the temporary PDF file
Kill payslip

' Delay between emails (2 seconds)
Application.Wait Now + TimeValue("0:00:02")

' Clear the email object for the next iteration
Set OutlookMail = Nothing
End If
Next cell

' Release Outlook object
Set OutlookApp = Nothing

MsgBox "Emails sent successfully!"

Exit Sub

ErrorHandler:
MsgBox "An error occurred while sending emails. Please check your Outlook configuration and try again."
End Sub


Problem
I use outlook to send mail. Everybody received the same payslip instead of payslip that is personal to individuals. That is, the payslip of the person selected at the point of running the macro.
I want individuals to receive what belong to them.

Kindly help me out.

 

[davesexcel]

Don't you still need D5 to = cell.value?

Right now you are just looping through a range, you are not changing the pay slip

 

[tayomi]

Don't you still need D5 to = cell.value?

Right now you are just looping through a range, you are not changing the pay slip

Please what is the way forward because I am just learning VBA. What code will be changing pay slip?

 

[tayomi]

Don't you still need D5 to = cell.value?

Right now you are just looping through a range, you are not changing the pay slip

D5 contains data validation list such where I can select staff names and the other fields change accordingly.

 

[davesexcel]

Yes and you need range("D5")=cell from your loop

 

[Skyybot]

Try this;

Sub EmailPayslipToDataValidationList()
On Error GoTo ErrorHandler

Dim ws As Worksheet
Dim rngDataValidation As Range
Dim cell As Range
Dim OutlookApp As Object
Dim OutlookMail As Object
Dim payslip As String

' Set the worksheet and range containing the data validation list
Set ws = ThisWorkbook.Worksheets("PAYSLIP") ' Replace "Sheet1" with your actual worksheet name
Set rngDataValidation = ws.Range("J5:J54") ' Replace A1:A10 with the range containing your data validation list

' Create Outlook objects
Set OutlookApp = CreateObject("Outlook.Application")

' Loop through each cell in the data validation list
For Each cell In rngDataValidation
' Skip empty cells and header row
If Not IsEmpty(cell) And cell.Row <> 1 Then
' Set PAYSLIP Employee name to change the data <----------Added lines here
ws.Range("D5") = cell.Value
' Set the print area based on the cell's row
ws.PageSetup.PrintArea = ws.Range("B2:F16" & cell.Row).CurrentRegion.Address

' Create a temporary PDF file name
payslip = Environ("TEMP") & "\" & "Payslip.pdf"

' Export the print area as PDF
ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:=payslip, Quality:=xlQualityStandard

' Create a new email
Set OutlookMail = OutlookApp.CreateItem(0)

' Set email properties
With OutlookMail
.Subject = "Payslip"
.Body = "Please find attached your payslip."
.To = cell.Value ' Assumes the email addresses are in the same column as the data validation list
.Attachments.Add payslip
.Send
End With

' Delete the temporary PDF file
Kill payslip

' Delay between emails (2 seconds)
Application.Wait Now + TimeValue("0:00:02")

' Clear the email object for the next iteration
Set OutlookMail = Nothing
End If
Next cell

' Release Outlook object
Set OutlookApp = Nothing

MsgBox "Emails sent successfully!"

Exit Sub

ErrorHandler:
MsgBox "An error occurred while sending emails. Please check your Outlook configuration and try again."
End Sub

 

[Fluff]

Welcome to the MrExcel Message Board!

Cross-posting (posting the same question in more than one forum) is not against our rules, but the method of doing so is covered by #13 of the Forum Rules.

Be sure to follow & read the link at the end of the rule too!

Cross posted at: VBA to email pay slip to all staff at once - OzGrid Free Excel/VBA Help Forum
There is no need to repeat the link(s) provided above but if you have posted the question at other places, please provide links to those as well.

If you do cross-post in the future and also provide links, then there shouldn’t be a problem.

 

[tayomi]

Try this;

Sub EmailPayslipToDataValidationList()
On Error GoTo ErrorHandler

Dim ws As Worksheet
Dim rngDataValidation As Range
Dim cell As Range
Dim OutlookApp As Object
Dim OutlookMail As Object
Dim payslip As String

' Set the worksheet and range containing the data validation list
Set ws = ThisWorkbook.Worksheets("PAYSLIP") ' Replace "Sheet1" with your actual worksheet name
Set rngDataValidation = ws.Range("J5:J54") ' Replace A1:A10 with the range containing your data validation list

' Create Outlook objects
Set OutlookApp = CreateObject("Outlook.Application")

' Loop through each cell in the data validation list
For Each cell In rngDataValidation
' Skip empty cells and header row
If Not IsEmpty(cell) And cell.Row <> 1 Then
' Set PAYSLIP Employee name to change the data <----------Added lines here
ws.Range("D5") = cell.Value
' Set the print area based on the cell's row
ws.PageSetup.PrintArea = ws.Range("B2:F16" & cell.Row).CurrentRegion.Address

' Create a temporary PDF file name
payslip = Environ("TEMP") & "\" & "Payslip.pdf"

' Export the print area as PDF
ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:=payslip, Quality:=xlQualityStandard

' Create a new email
Set OutlookMail = OutlookApp.CreateItem(0)

' Set email properties
With OutlookMail
.Subject = "Payslip"
.Body = "Please find attached your payslip."
.To = cell.Value ' Assumes the email addresses are in the same column as the data validation list
.Attachments.Add payslip
.Send
End With

' Delete the temporary PDF file
Kill payslip

' Delay between emails (2 seconds)
Application.Wait Now + TimeValue("0:00:02")

' Clear the email object for the next iteration
Set OutlookMail = Nothing
End If
Next cell

' Release Outlook object
Set OutlookApp = Nothing

MsgBox "Emails sent successfully!"

Exit Sub

ErrorHandler:
MsgBox "An error occurred while sending emails. Please check your Outlook configuration and try again."
End Sub

Try this;

Sub EmailPayslipToDataValidationList()
On Error GoTo ErrorHandler

Dim ws As Worksheet
Dim rngDataValidation As Range
Dim cell As Range
Dim OutlookApp As Object
Dim OutlookMail As Object
Dim payslip As String

' Set the worksheet and range containing the data validation list
Set ws = ThisWorkbook.Worksheets("PAYSLIP") ' Replace "Sheet1" with your actual worksheet name
Set rngDataValidation = ws.Range("J5:J54") ' Replace A1:A10 with the range containing your data validation list

' Create Outlook objects
Set OutlookApp = CreateObject("Outlook.Application")

' Loop through each cell in the data validation list
For Each cell In rngDataValidation
' Skip empty cells and header row
If Not IsEmpty(cell) And cell.Row <> 1 Then
' Set PAYSLIP Employee name to change the data <----------Added lines here
ws.Range("D5") = cell.Value
' Set the print area based on the cell's row
ws.PageSetup.PrintArea = ws.Range("B2:F16" & cell.Row).CurrentRegion.Address

' Create a temporary PDF file name
payslip = Environ("TEMP") & "\" & "Payslip.pdf"

' Export the print area as PDF
ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:=payslip, Quality:=xlQualityStandard

' Create a new email
Set OutlookMail = OutlookApp.CreateItem(0)

' Set email properties
With OutlookMail
.Subject = "Payslip"
.Body = "Please find attached your payslip."
.To = cell.Value ' Assumes the email addresses are in the same column as the data validation list
.Attachments.Add payslip
.Send
End With

' Delete the temporary PDF file
Kill payslip

' Delay between emails (2 seconds)
Application.Wait Now + TimeValue("0:00:02")

' Clear the email object for the next iteration
Set OutlookMail = Nothing
End If
Next cell

' Release Outlook object
Set OutlookApp = Nothing

MsgBox "Emails sent successfully!"

Exit Sub

ErrorHandler:
MsgBox "An error occurred while sending emails. Please check your Outlook configuration and try again."
End Sub

Thank you for this. it addresses the problem of sending personalized pay slip to individual what belongs to them but another thing pops up. Now, it is only one person that received the mail out of those whose email address were inserted. others said they did not receive email message unlike before that everyone was receiving the same message. I will appreciate if all can receive theirs. Thank you for the one done.

 

[davesexcel]

..

.To = cell.Value ' Assumes the email addresses are in the same column as the data validation list
.Attachments.Add payslip
.Send
........


Problem
I use outlook to send mail. Everybody received the same payslip instead of payslip that is personal to individuals. .......

I don't see how anybody received emails, you are looping through column J, but the Email address are in column K.
To get the column K value.

.to = cell.offset(0,1)'assumes email is in same row

 

[tayomi]

A

I don't see how anybody received emails, you are looping through column J, but the Email address are in column K.
To get the column K value.

.to = cell.offset(0,1)'assumes email is in same row

A big thanks to my instructor here. The code run and delivered successfully. Thanks, Thanks and Thanks!!!!