Setting flag follow up for next business day

Not open for further replies.


Outlook version
Outlook 2016 32 bit
Email Account
I want to be able to run this macro and instead of just flagging the follow up for the next day, I would like it to set it for the next business day. Can anyone help?

Sub ForwardFlag()

Call ForwardAttachment
Call Set_FollowUp

End Sub
Sub ForwardAttachment()
    Dim MyItem As Object 'original email
    Dim MyFwdItem As MailItem 'forward email
    Dim strSub As String 'subject string
    Dim Signature As String 'signature string
    Dim strBody As String
    Set MyItem = ActiveExplorer.Selection(1)
    If MyItem.Class = olMail Then 'check if mail item is selected
        'code to change & manipulate subject of email
        strSub = MyItem.Subject
        strSub = Replace(strSub, "RE: ", "")
        strSub = Replace(strSub, "FW: ", "")
        strBody = MyItem.Body
        strBody = "<font size=""3"" face=""calibri"">"
        Set MyFwdItem = MyItem.Forward
        'code to select signature from default location. if none found it will put signature as blank
        Signature = Environ("appdata") & "\Microsoft\Signatures\" 'default signature location
        If Dir(Signature, vbDirectory) <> vbNullString Then
            Signature = Signature & Dir$(Signature & "*.htm")
            Signature = CreateObject("Scripting.FileSystemObject").GetFile(Signature).OpenAsTextStream(1, -2).ReadAll
            Signature = ""
        End If

        'set email parameters
        With MyFwdItem
            .To = ""
            .Subject = strSub
            .HTMLBody = strBody & "<br>" & Signature
            .Display 'replace with .send once your happy it works
        End With
        Set MyFwdItem = Nothing
        MsgBox "Select a mailitem and try again"
    End If

    Set MyItem = Nothing
End Sub

Sub Set_FollowUp()

    Dim numDays As Double
    Dim uPrompt As String
    Dim MyMailItem As Object

startDate = Now + 1

    On Error Resume Next
    If ActiveInspector.CurrentItem.Class = olMail Then
        Set MyMailItem = ActiveInspector.CurrentItem
    End If

    If MyMailItem Is Nothing Then
    ' Might be in the explorer window

        If (ActiveExplorer.Selection.Count = 1) And _
          (ActiveExplorer.Selection.Item(1).Class = olMail) Then

            Set MyMailItem = ActiveExplorer.Selection.Item(1)

        End If
    End If

    If MyMailItem Is Nothing Then
        MsgBox "Problem." & vbCr & vbCr & "Try again " & _
         "under one of the following conditions:" & vbCr & _
         "-- You are viewing a single message." & vbCr & _
         "-- You have only one message selected.", _
        Exit Sub
    End If

    MyMailItem.FlagDueBy = startDate

    ' *** optional code ***
    'uPrompt = "Follow-Up how many days from now? Decimals allowed."
    'numDays = InputBox(prompt:=uPrompt, Default:=1)

    'MyMailItem.FlagDueBy = Now + numDays
    'MyMailItem.FlagRequest = "Customized Follow up"
    ' *** end of optional code ***

End Sub

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
startDate = Now + 1
is what needs changed. Outlook doesn't have a next business day function, so you need to use the function here - Create Outlook appointments for every nn workday -

replace that line with

' 65 = skip Sat/Sun
nextDate = Workday2(Date, NumOfDays + 1, 65)
startDate = nextDate

and use the Workday2 Function from that page - and the holiday sub if you want to check your calendar for all day events marked busy and skip them.
Not open for further replies.