Sub Button7_Click2()
Dim OutApp As Object, OutMail As Object
Dim printFrom As Variant, printTo As Variant, mk As Long
Dim sFile As String, sPath As String
Dim i As Long
Dim j As Long
Dim FName As String
Dim fso As Object
Dim wbNew As Workbook, wbThis As Workbook
Dim Answer As Integer
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
On Error GoTo lbFinally
Answer = MsgBox("Do you want to save file and send mail?", vbQuestion + vbYesNo)
If Answer = vbYes Then
'MsgBox "You Choose Yes"
FName = ThisWorkbook.Path & "\PhieuLuong - " & Format(Now, "MMM DD YY")
Const DeleteReadOnly = True
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FolderExists(FName) Then
fso.DeleteFolder (FName), DeleteReadOnly
fso.CreateFolder (FName)
End If
If Not fso.FolderExists(FName) Then
fso.CreateFolder (FName)
End If
Set wbThis = ThisWorkbook
printFrom = wbThis.Sheets("PAYSLIP").Range("I8")
printTo = wbThis.Sheets("PAYSLIP").Range("I9")
' mk = wbThis.Sheets("PAYSLIP").Range("I14")
Set OutApp = CreateObject("Outlook.Application")
For i = printFrom To printTo
wbThis.Sheets("PAYSLIP").Range("I5") = i
mk = wbThis.Sheets("PAYSLIP").Range("I14")
Set wbNew = Workbooks.Add(xlWBATWorksheet)
wbThis.Sheets("PAYSLIP").Range("A1:D33").Copy
With wbNew.Sheets(1)
.Range("A1:D33").PasteSpecial xlPasteValues
.Range("A1:D33").PasteSpecial xlPasteFormats
.Columns("A:D").AutoFit
End With
Application.CutCopyMode = False
sFile = FName & "\" & wbThis.Sheets("PAYSLIP").Range("A9") & " - " & wbThis.Sheets("PAYSLIP").Range("B13") & ".xlsx"
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = wbThis.Sheets("PAYSLIP").Range("B12")
.cc = ""
.BCC = ""
.Subject = wbThis.Sheets("PAYSLIP").Range("A9")
.HTMLBody = " Dear " & wbThis.Sheets("PAYSLIP").Range("B11") & "</B> <BR><BR> Kindly find attachment payslip. <BR>" & _
"<BR>Should you have any questions, do not hestitate to contact us." & _
"<BR><BR>Thanks & regards</B><BR>" & _
"</B>"
wbNew.SaveAs Filename:=sFile, FileFormat:=51, Password:=mk, ReadOnlyRecommended:=True, CreateBackup:=False
wbNew.Close False
Set wbNew = Nothing
.Attachments.Add (sFile)
.send
End With
Set OutMail = Nothing
Next i
Set OutApp = Nothing
Set OutMail = Nothing
MsgBox "Mail send successfully"
Else
MsgBox "No Choose """
End If
lbFinally:
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationSemiautomatic
If Err <> 0 Then
MsgBox Err.Description, vbCritical
End If
End Sub