Macro to excute on first business day of each month.

[ashfaqbsayed]

Macro to excute on first business day of each month to send a email from outlook
for eg if 1st comes on saturday it will excute a email on monday, if 1st comes on friday it will excute a email on friday.
Below is the code attached

Sub Monthly()
  Dim OutApp As Object
  Dim OutMail As Object
  Set OutApp = CreateObject("Outlook.Application")
  Set OutMail = OutApp.CreateItem(0)
  On Error Resume Next
  With OutMail
  '.To = "ababulal@lesterinc.com"
  .CC = "ababulal@lesterinc.com"
  If range("aa3").Value = 5 Then
  .To = "rmaskell@lesterinc.com;emisquitta@lesterinc.com;fshaikh@lesterinc.com;rshetty@lesterinc.com"
  .Subject = "Agent score card for month of " & Format(Date - Day(4), "mmmm, yyyy.")
  '.Subject = ThisWorkbook.Sheets("Daily Points ").range("A1").Value
  .Body = "Hi," & vbLf & vbLf & "  PFA Agent Score Card For Month of " & _
  Format(Date - Day(4), "mmmm, yyyy.") & vbLf & vbLf & _
"Please Note : Will send the updated Score Card once we receive the Final Agent Error Report from QC." & vbLf & vbLf & _
"Thanks," & vbLf & _
"Ashfaq Sayed."
Application.Run "'z daily points.xls'!Create_Agent_Score_Card_For_Month"
  AttachPath = "Z:\Supervisors\For Z from Richard\"
  AttachDoc = AttachPath & "Agent score card for month of " & Format(Date - Day(4), "mmmm, yyyy.") & ".xlsm"
  .Attachments.Add (AttachDoc)
  .Send 'or use .Display
  End If
  If Weekday(Now()) = 4 Then
  range("AA3").FormulaR1C1 = "=WEEKNUM(NOW()-DAY(10),2)-WEEKNUM(DATE(YEAR(NOW()-DAY(10)),MONTH(NOW()-DAY(10)),1),2)+1&""""&CHOOSE(AND(MOD(WEEKNUM(NOW()-DAY(10),2)-WEEKNUM(DATE(YEAR(NOW()-DAY(10)),MONTH(NOW()-DAY(10)),1),2)+1,100)<>{11,12,13})*MIN(4,MOD(WEEKNUM(NOW()-DAY(10),2)-WEEKNUM(DATE(YEAR(NOW()-DAY(10)),MONTH(NOW()-DAY(10)),1),2)+1,10))+1,""th"",""st"",""nd"",""rd"",""th"")&"" Week of ""&TEXT(NOW()-DAY(4),""mmmm, yyyy."")"
  .To = "rmaskell@lesterinc.com;saraswathij@lesterinc.com;sdabir@lesterinc.com;hsuthar@lesterinc.com;emisquitta@lesterinc.com;fshaikh@lesterinc.com;rshetty@lesterinc.com"
  .Subject = "Weekly inc to monitor call for " & ThisWorkbook.Sheets("Hourly & Campaign").range("X1").Value
  .Body = "Hi," & vbLf & vbLf & "  PFA Weekly inc to monitor call for " & _
  ThisWorkbook.Sheets("Hourly & Campaign").range("X1").Value & vbLf & vbLf & _
"Please Note : Saif let me now if there is any tie between any position from 1st to 5th." & vbLf & vbLf & _
"Thanks," & vbLf & _
"Ashfaq Sayed."
Application.Run "'z daily points.xls'!WeeklytoQC"
  .Attachments.Add ("Z:\Common\QC DAILY REPORTS\2015\Agent QC Report & weekly inc 2015.xls")
  .Send 'or use .Display
  End If
  End With
  On Error GoTo 0
  Set OutMail = Nothing
  Set OutApp = Nothing
  Sheets("Hourly & Campaign").Select
End Sub