Outlook scheduling

RCBricker

Well-known Member
Joined
Feb 4, 2003
Messages
1,560
I am trying to set a deadline appointment in my calendar for a specific day each month. However, When that date falls on a week end I need to accomplish it earlier. How can I tell Outlook to set an appointment for the 10th of each month and to adjust to the Friday prior to the 10th if the 10th lands on a weekend?

Any suggestions?

Thank you in advance for your help and suggestions.

Rich
 

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.
here is something i put together last year in OUTLOOK, prompts for 2 names and creates a calender appointment, 30 days from todays date, if it falls on a weekend, it advances to monday @ 08:15

it should give you some pointers

Code:
'****
' procedure to assist in deletion of user accounts cutting down the keystrokes
' prompt for username(s) and create a calendar appointment
'
' Author        Jim Ward
' Creation      16th April 2010
'****
'
Sub DeleteAccountAppoint()
Dim EndDate As Date
Dim FutureDate As Date

'
'****
' Get a list of username(s)
'****
'
Dim strName As String

strName = InputBox(Prompt:="Enter User To Be Deleted", _
          Title:="Enter User Name", Default:="Users Name here")

If strName = "Users Name here" Or strName = vbNullString Then
    Exit Sub
End If

'
'****
' Get Requestor Name
'****
'
Dim ReqName As String

ReqName = InputBox(Prompt:="Who Requested The Deletion (FirstName Surname)", _
          Title:="Enter Name", Default:="Requesting Name here")

If ReqName = "Requesting Name here" Or strName = vbNullString Then
    Exit Sub
End If


'
'****
' Get Todays date, add 30 days
' check if saturday or sunday advance if needed
' add 8 hours
'****
'

FutureDate = Date + 30
wDay = Weekday(FutureDate, vbMonday)
If wDay = 6 Then
    FutureDate = FutureDate + 2
End If
If wDay = 7 Then
    FutureDate = FutureDate + 1
End If

'
'****
' Add 8 hours as the above sets to midnight, then add 15mins for 08:15
'****
'

FutureDate = FutureDate + TimeSerial(8, 0, 0)
EndDate = FutureDate + TimeSerial(0, 15, 0)

'
'****
' Create appointment 
'****
'

CreateAppointment "Account Deletion", "Delete Accounts for " + strName, FutureDate, EndDate, False

MsgBox ("Deletion Appointment Created for " & strName & " on " & FutureDate)

End Sub
'
'****
'Function to create calendar item, nabbed from my friend google
'****
'
Public Function CreateAppointment(SubjectStr As String, BodyStr As String, StartTime As Date, EndTime As Date, AllDay As Boolean)
     Dim OlApp As Outlook.Application
     Dim Appt As Outlook.AppointmentItem
     Set OlApp = CreateObject("Outlook.Application")
     Set Appt = OlApp.CreateItem(olAppointmentItem)
     Appt.Subject = SubjectStr
     Appt.Start = StartTime
     Appt.End = EndTime
     Appt.AllDayEvent = AllDay
     Appt.Body = BodyStr
     Appt.Save
     Set Appt = Nothing
     Set OlApp = Nothing
End Function
 
Upvote 0

Forum statistics

Threads
1,225,606
Messages
6,185,956
Members
453,333
Latest member
BioCoder84

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top