Question

I’m totally new to Excel VBA. I am using Microsoft 2003 excel.

What my superior tasked me to do was to create a Leave Management System that tracks down an employee’s amount of days left in terms of leave and from there, send an email down to her, her secretary and the employee regarding the status of approved or rejected.

I did try out some codes of VBA.. But I do not know how really the mail sending function works? Do i send the attachment out? Or when i entered some value in the code, it will auto send the whole attachment over? I’m really lost here, thank you!

Sub Mail_sheets()
Dim MyArr As Variant
Dim last As Long
Dim shname As Long
Dim a As Integer
Dim Arr() As String
Dim N As Integer
Dim strdate As String
For a = 1 To 253 Step 3
    If ThisWorkbook.Sheets("mail").Cells(1, a).Value = "" Then
        Exit Sub
    End
    Application.ScreenUpdating = False
    last = ThisWorkbook.Sheets("mail").Cells(Rows.Count, _
        a).End(xlUp).Row
    N = 0
    For shname = 1 To last
        N = N + 1
        ReDim Preserve Arr(1 To N)
        Arr(N) = ThisWorkbook.Sheets("mail").Cells(shname, a).Value
    Next shname
    ThisWorkbook.Sheets(Arr).Copy
    strdate = Format(Date, "dd-mm-yy") & " " & _
        Format(Time, "h-mm-ss")
    ActiveWorkbook.SaveAs "Part of " & ThisWorkbook.Name _
        & " " & strdate & ".xls"
    With ThisWorkbook.Sheets("mail")
        MyArr = .Range(.Cells(1, a + 1), .Cells(Rows.Count, _
            a + 1).End(xlUp))
    End With
    ActiveWorkbook.SendMail MyArr, ThisWorkbook.Sheets("mail").Cells(1, a + 2).Value
    ActiveWorkbook.ChangeFileAccess xlReadOnly
    Kill ActiveWorkbook.FullName
    ActiveWorkbook.Close False
    Application.ScreenUpdating = True
Next a
End Sub

Answer 1

Here is an example on how to achieve what you want. Please amend it for your actual needs.

I did try out some codes of VBA.. But I do not know how really the mail sending function works? Do i send the attachment out?

You don’t need to send the entire workbook as an attachment. You can send a simple email stating whether the leave is approved or rejected. If you need to support why you are rejecting or approving the leave then you can paste the relevant cells in the email. See this example.

I am assuming for a moment that you worksheet looks like this.

Now suppose the employee Siddharth wants to take a leave. As we can see in the snapshot, the employee has 0 leaves balance. So the request for leave will be declined and a mail will be shot to the relevant person/Dept

When you run the code, it will ask you to enter the employees name

and then sends the relevant email.

CODE

Option Explicit

'~~> To Field in Email
Const strTo As String = "[e-mail]"
'~~> CC field in email. If you do not want to CC then change "[e-mail]" to ""
Const strCC As String = "[e-mail]"

'~~> This is what goes in the body
Const strBody1 As String = "Dear XYZ,"
Const strBody2 As String = "This is in reference to leave request for employee "

Const strBodyApp As String = "The employee has sufficient leave balance and can take the leave"
Const strBodyNotApp As String = "The employee doesn't have sufficient leave balance and hence cannot take the leave"
Const strByeBye  As String = "Thanks and Regards"
Const sender As String = "ABC"

Sub Sample()
    Dim ws As Worksheet
    Dim aCell As Range
    Dim Ret
    Dim Bal As Long
    Dim Rw As Long

    Ret = Application.InputBox("Please enter the name of the employee who wants to take a leave")

    If Ret = "" Then Exit Sub

    Set ws = Sheets("Sheet3")

    Set aCell = ws.Columns(2).Find(What:=Ret, LookIn:=xlValues, _
    LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False)

    If Not aCell Is Nothing Then
        Bal = aCell.Offset(, 5).Value
        Rw = aCell.Row

        If Bal > 0 Then
            Approved Ret, True, Rw
        Else
            Approved Ret, False, Rw
        End If
    Else
        MsgBox "The employee " & Ret & " was not found"
    End If
End Sub

Sub Approved(EmpName, app As Boolean, lRow As Long)
    Dim msg As String
    Dim rng As Range
    Dim OutApp As Object
    Dim OutMail As Object

    If app = True Then
        msg = "<p class=MsoNormal>" & strBody1 & "<o:p></o:p></p>" & vbNewLine & _
               "<p class=MsoNormal><o:p>&nbsp;</o:p></p>" & vbNewLine & _
               "<p class=MsoNormal>" & strBody2 & EmpName & ". " & strBodyApp & _
               "<span style='mso-fareast-font-family:""Times New Roman""'><o:p></o:p></span></p>"
    Else
        msg = "<p class=MsoNormal>" & strBody1 & "<o:p></o:p></p>" & vbNewLine & _
               "<p class=MsoNormal><o:p>&nbsp;</o:p></p>" & vbNewLine & _
               "<p class=MsoNormal>" & strBody2 & EmpName & ". " & strBodyNotApp & _
               "<span style='mso-fareast-font-family:""Times New Roman""'><o:p></o:p></span></p>"
    End If

    Set rng = Sheets("Sheet3").Range("A1:F1" & ",A" & lRow & ":F" & lRow)

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
    With OutMail
        .To = strTo
        .CC = strCC
        .BCC = ""
        .Subject = "Leave Status"

        .HTMLBody = msg & _
                    RangetoHTML(rng) & _
                    "<p class=MsoNormal><span style='mso-fareast-font-family:""Times New Roman""'>" & strByeBye & "<o:p></o:p></span></p>" & _
                    "<p class=MsoNormal><span style='mso-fareast-font-family:""Times New Roman""'><o:p>&nbsp;</o:p></span></p>" & _
                    "<p class=MsoNormal><span style='mso-fareast-font-family:""Times New Roman""'>" & sender & "<o:p></o:p></span></p>"

        .Display   '.Send 'To send the email
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

'~~> Taken from http://www.rondebruin.nl/mail/folder3/mail4.htm
Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2010
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook

    TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

    'Copy the range and create a new workbook to past the data in
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With

    'Publish the sheet to a htm file
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         fileName:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With

    'Read all data from the htm file into RangetoHTML
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.ReadAll
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")

    'Close TempWB
    TempWB.Close savechanges:=False

    'Delete the htm file we used in this function
    Kill TempFile

    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function

DISCLAIMER: Since the above code is a basic example, I have not

1) included Error handling (which you should)

2) used basic stuff as Application.ScreenUpdating

SAMPLE FILE: This link will be active for the next 7 days. I have uploaded a sample file for you to play with 🙂

http://wikisend.com/download/562482/Sample.xls

HTH