Results 1 to 5 of 5

Thread: Chosing Attachment Based On Condition Before Sending Mail In Outlook

  1. #1
    Junior Member
    Join Date
    Feb 2013
    Posts
    5
    Rep Power
    0

    Chosing Attachment Based On Condition Before Sending Mail In Outlook

    Hi,

    I have a Macro for sending outlook, but i want to modify it using attached mail templates:

    Template 1, if there is 1 item that is more than 30 days (column C)
    Template 2, if there are 2 or more items that are more than 30 days
    Template 3, if there is no item that is more than 30 days.

    Subject also varies depending on the template.

    Thanks,

    AkiOutlook sending2.xlsSample templates.docxSample mails.xlsx

  2. #2
    Administrator Excel Fox's Avatar
    Join Date
    Mar 2011
    Posts
    1,402
    Rep Power
    10
    This should do most of the work.

    Code:
    Option Explicit
    Sub Send_Row_Or_Rows_1()
    ' Don't forget to copy the function RangetoHTML in the module.
    ' Working in Office 2000-2010
        Dim OutApp As Object
        Dim OutMail As Object
        Dim rng As Range
        Dim Ash As Worksheet
        Dim Cws As Worksheet
        Dim Rcount As Long
        Dim Rnum As Long
        Dim FilterRange As Range
        Dim FieldNum As Integer
        Dim mailAddress As String
        Dim strSituation As String
        Dim lngOutlier As Long
        On Error GoTo cleanup
        Set OutApp = CreateObject("Outlook.Application")
        With Application
            .EnableEvents = False
            .ScreenUpdating = False
        End With
        'Set filter sheet, you can also use Sheets("MySheet")
        Set Ash = ActiveSheet
        Ash.AutoFilterMode = False
        'Set filter range and filter column (Column with names)
        Set FilterRange = Ash.Range("A1:G" & Ash.Cells(Rows.Count, 1).End(xlUp).Row)
        FieldNum = 1    'Filter column = A because the filter range start in A
        'Add a worksheet for the unique list and copy the unique list in A1
        Set Cws = Worksheets.Add
        FilterRange.Columns(FieldNum).AdvancedFilter _
                Action:=xlFilterCopy, _
                CopyToRange:=Cws.Range("A1"), _
                CriteriaRange:="", Unique:=True
        'Count of the unique values + the header cell
        Rcount = Cws.UsedRange.Rows.Count
        'If there are unique values start the loop
        If Rcount >= 2 Then
            For Rnum = 2 To Rcount
                'Filter the FilterRange on the FieldNum column
                FilterRange.AutoFilter Field:=FieldNum, Criteria1:=Cws.Cells(Rnum, 1).Value
                lngOutlier = WorksheetFunction.CountIfs(FilterRange.Columns(1).Cells, Cws.Cells(Rnum, 1).Value, FilterRange.Columns(3).Cells, ">30")
                Select Case lngOutlier
                    Case Is >= 1
                        strSituation = ">30"
                    Case Else
                        lngOutlier = WorksheetFunction.CountIfs(FilterRange.Columns(1).Cells, Cws.Cells(Rnum, 1).Value, FilterRange.Columns(3).Cells, "<=30")
                        strSituation = "<=30"
                End Select
                'Look for the mail address in the MailInfo worksheet
                mailAddress = ""
                On Error Resume Next
                mailAddress = Application.WorksheetFunction. _
                              VLookup(Cws.Cells(Rnum, 1).Value, _
                                    Worksheets("Mailinfo").Range("A1:B" & _
                                    Worksheets("Mailinfo").Rows.Count), 2, False)
                On Error GoTo 0
                If mailAddress <> "" Then
                    With Ash.AutoFilter.Range
                        On Error Resume Next
                        Set rng = .SpecialCells(xlCellTypeVisible)
                        On Error GoTo 0
                    End With
                    Set OutMail = OutApp.CreateItem(0)
                    On Error Resume Next
                    With OutMail
                        .To = mailAddress
                        .Subject = "Test mail"
                        .body = MesgToPass(strSituation, lngOutlier)
                        .htmlbody = .htmlbody & RangetoHTML(rng) & MesgToPass("")
                        .Display  'Or use Send
                    End With
                    On Error GoTo 0
                    Set OutMail = Nothing
                End If
                'Close AutoFilter
                Ash.AutoFilterMode = False
            Next Rnum
        End If
    cleanup:
        Set OutApp = Nothing
        Application.DisplayAlerts = False
        Cws.Delete
        Application.DisplayAlerts = True
        With Application
            .EnableEvents = True
            .ScreenUpdating = True
        End With
    End Sub
    Function MesgToPass(strSituation As String, Optional lngOutlier As Long)
        Dim str As String
        
        Select Case strSituation
            Case ">30"
            If lngOutlier > 1 Then
                str = "Hi Dear,"
                str = str & vbCrLf & ""
                str = str & vbCrLf & "We have " & lngOutlier & " open workflows which are open in the system for more than 30 days and were located in your inbox."
                str = str & vbCrLf & ""
                str = str & vbCrLf & "Have included workflows with average duration of 0-30 days so as not to wait for them to be delayed before we send another reminder. Kindly provide your support in closing/processing these open items as soon as possible. Our goal is to have no open workflow over 30 days. Please give advice if you're unable to do so due to some issues you're encountering. If workflow is incorrectly sent to your inbox, please advise workflow number and forwarder."
            ElseIf lngOutlier = 1 Then
                str = str & "Hi Dear,"
                str = str & vbCrLf & ""
                str = str & vbCrLf & "We have 1 open workflow which is open in the system for more than 30 days and is located in your inbox."
                str = str & vbCrLf & ""
                str = str & vbCrLf & "Kindly provide your support in closing/processing this open item as soon as possible. Our goal is to have no open workflow over 30 days. Please give advice if you're unable to do so due to some issues you're encountering. If workflow is incorrectly sent to your inbox, please advise workflow number and forwarder."
            End If
            Case "<=30"
                str = str & "Hi Dear,"
                str = str & vbCrLf & ""
                str = str & vbCrLf & "See below workflows with average duration of 0-30 days that are located in your inbox and kindly prioritize these so it won't be delayed before we send another reminder. Please provide your support in closing/processing these open items as soon as possible. If workflow is incorrectly sent to your inbox, please advise workflow number and forwarder."
            Case Else
                str = str & vbCrLf & "<P><FONT FACE=""Calibri"">"
                str = str & vbCrLf & ""
                str = str & vbCrLf & ""
                str = str & vbCrLf & "Hoping for your utmost cooperation."
                str = str & vbCrLf & "<P><P></P></P>"
                str = str & vbCrLf & "Thank you and Best Regards,</FONT></P>"
            End Select
            MesgToPass = str
            
    End Function
    A dream is not something you see when you are asleep, but something you strive for when you are awake.

    It's usually a bad idea to say that something can't be done.

    The difference between dream and aim, is that one requires soundless sleep to see and the other requires sleepless efforts to achieve

    Join us at Facebook

  3. #3
    Junior Member
    Join Date
    Feb 2013
    Posts
    5
    Rep Power
    0
    Thank you for the help, but i still have one question, what if the subject changed depending also on the template to be sent.

    1. if there are 2 or more items that are more than 30 day: the subject is "Multiple workflows with more than 30 days"
    2. if only one item is more than 30 days: "Single WF with more than 30 days"
    3. if no more thank 30 days: "Workflows without more than 30days"

    Thanks in advance

  4. #4
    Administrator Excel Fox's Avatar
    Join Date
    Mar 2011
    Posts
    1,402
    Rep Power
    10
    Add this to the module

    Code:
    Function SubjToPass(strSituation As String, Optional lngOutlier As Long)
    
        Dim str As String
        Select Case strSituation
            Case ">30"
            If lngOutlier > 1 Then
                SubjToPass = "Multiple workflows with more than 30 days"
            ElseIf lngOutlier = 1 Then
                SubjToPass = "Single WF with more than 30 days"
            End If
            Case "<=30"
                SubjToPass = "Workflows without more than 30days"
            End Select
            
    End Function
    And in the subject line, use

    Code:
    .Subect = SubjToPass(strSituation, lngOutlier)
    A dream is not something you see when you are asleep, but something you strive for when you are awake.

    It's usually a bad idea to say that something can't be done.

    The difference between dream and aim, is that one requires soundless sleep to see and the other requires sleepless efforts to achieve

    Join us at Facebook

  5. #5
    Junior Member
    Join Date
    Feb 2013
    Posts
    5
    Rep Power
    0
    I have edited the macro, but when i save the macro to our shared folders, the macro won't work, do you have idea why? also there are cases which the macro work,

    1. if i create a new file, copying all macro, then it works, but when i transfered or save the file from ather share folders, the macro is not working.
    2. if it is save and wont work, i am running the VBA, then the open sheet is "Mailinfo" the macro is running but it copies the date from the said sheet.
    Attached Files Attached Files

Similar Threads

  1. Replies: 26
    Last Post: 10-22-2019, 02:39 PM
  2. Replies: 6
    Last Post: 06-05-2013, 11:33 PM
  3. Check for Missing Attachment and Subject in Outlook
    By Transformer in forum Tips, Tricks & Downloads (No Questions)
    Replies: 0
    Last Post: 05-17-2013, 12:32 AM
  4. Formula Based On Condition
    By Aryan063007 in forum Excel Help
    Replies: 4
    Last Post: 10-09-2012, 10:37 AM
  5. Replies: 3
    Last Post: 02-20-2012, 12:54 AM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •