Your "VBA CODE" refers to sheets that don't exist in your workbook. Please explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data. It would also help if you include a sheet that shows what your email should look like.
Why not simply use MSWord's Mail Merge?
Lots of tips and tricks at https://www.msofficeforums.com…ailmerge-tips-tricks.html and https://yamm.com/blog/mail-merge-excel/
Do you want to create a PDF of the payslip for all employees, save that pdf and send it as an email attachment to each employee?
Try the attached, click the button on the "Payroll calculator" sheet (after updating the Period in cell W2).
The code will create a Salary Slip for all employees who have worked at least one day during the month (employee has a value greater than 0 in Payroll calculator Column G). A PDF will be created and saved to a sub-folder in the same folder as the Salary OTP-2022 workbook, if the sub-folder does not exist the code will create it. That PDF file will then be emailed to the employee.
Code assigned to the button
Option Explicit
Sub PaySlip()
Dim x, y, i&, ii&, r As Range
Dim sName$, sBody$, sPn$, sFn$, sMnth$
Dim OutApp As Object, OutMail As Object
x = Sheets("Employee information").[a3].CurrentRegion
y = Sheets("Payroll calculator").[a3].CurrentRegion.Columns(4)
Application.ScreenUpdating = 0
Sheets("Salary Slip").Visible = -1
For i = 4 To UBound(x)
ii = Application.Match(x(i, 3), y, 0)
If y(ii, 1) > 0 Then
With Sheets("Salary Slip")
.[g9] = x(i, 2)
sName = x(i, 3)
sMnth = Format(.[g8], "mmm-yy")
sBody = "Dear " & sName & "<br><br>" & _
"<body>Attached please find your Salary slip for " & sMnth & _
"<br><br>" & "Regards," & _
"<br>" & "HR Department" & "</body>"
sPn = ThisWorkbook.Path & "\Salary slips - " & sMnth & "\"
If Dir(sPn) = "" Then MkDir sPn
sFn = sPn & sName & ".pdf"
.ExportAsFixedFormat 0, sFn, 0, 1, 0, , , 0
If x(i, 18) <> vbNullString Then
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = x(i, 18)
.Subject = "Salary slip - " & sMnth
.HTMLBody = sBody & "<br>" & .HTMLBody
.Attachments.Add sFn
.send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
Else
.PrintOut
End If
End With
End If
Next
Sheets("Salary Slip").Visible = 0
End SubNote that I added a column to the Employee information sheet for the email address of each employee. If an employee does not have an email address entered then his/her Salary Slip will be printed rather than emailed.
Depending on computer system the code will take approximately 45 seconds to create and email all the salary slip pdfs.
Don’t have an account yet? Register yourself now and be a part of our community!
