Setting flag follow up for next business day

[molonlabe]

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
        Else:
            Signature = ""
        End If

        'set email parameters
        With MyFwdItem
            .To = ""
            .Subject = strSub
            .HTMLBody = strBody & "<br>" & Signature
            .Display 'replace with .send once your happy it works
            '.Send
        End With
  
        Set MyFwdItem = Nothing
  
    Else
        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.", _
         vbInformation
        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 ***

    MyMailItem.Save
End Sub

 

[Diane Poremsky]

This:
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.