So today I was approached by an internet friend of mine Richard Tubb, he had a bit of a challenge for me. As a keen Ms Outlook user, he wanted to see if there was a way of delaying all emails that he’d composed and hit send on during the weekend to arrive on the next working day.
Of course, Ms Outlook has the built in deferred delivery time function.. However, setting that manually each time could easily become a bind. So that’s where this little Outlook VBA Snippet steps it.
The code checks to see if today is a weekday upon sending the email, and if it is either a Saturday or Sunday, it then finds the date of the next Monday, and sets the deferred send option to that Monday at 7AM. Of course, should Richard be sending mail through the week, Outlook will simply ignore the code. Simple really 
EDIT: So Richard came back to me with a second request, to delay mail sent on a weekday by 30 minutes, I have now adjusted the code to suit.
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
On Error GoTo ErrHand 'Error Handling
Dim nxtMonday As String 'Variable containing next Monday's date
Dim objMailItem As MailItem 'Object to hold mail item
Set objMailItem = Item 'Set object to mail item just sent
If Weekday(Date, vbMonday) = 6 Then 'Check to see if todays weekday value is 6 (http://msdn.microsoft.com/en-us/library/82yfs2zh(v=vs.80).aspx)
1: nxtMonday = Date + (2) 'As today is saturday, Monday is today + 2 days
2: objMailItem.DeferredDeliveryTime = nxtMonday & " 08:00:00" 'Set delayed delivery time to today + 2 days
Else
3: objMailItem.DeferredDeliveryTime = DateAdd("n", 30, Now) 'Else delay is + 30 minutes
End If
If Weekday(Date, vbMonday) = 7 Then 'Check to see if todays weekday value is 7
4: nxtMonday = Date + (1) 'As today is Sunday, Monday is today + 1 day
5: objMailItem.DeferredDeliveryTime = nxtMonday & " 08:00:00" 'Set delayed delivery time to today + 1 day
Else
6: objMailItem.DeferredDeliveryTime = DateAdd("n", 30, Now) 'Else delay is + 30 minutes
End If
Exit Sub
ErrHand: 'Due to lack of concentration of the code writing genius there has been a bit of an error,
'Lets tell someone about it by popping up a message box with a detailed description on the screen
MsgBox ("An error has occured on line " & Erl & ", with a description: " & Err.Description & ", and an error number " & _
Err.Number)
End Sub
If you find this code useful, or think you have a better way of doing this, drop me a line in the comments below!
Cheers
Mike
Use this simple VBScript in order to create a Windows System Restore Point.
' Create a System Restore Point
CONST DEVICE_DRIVER_INSTALL = 10
CONST BEGIN_SYSTEM_CHANGE = 100
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}" & strComputer & "rootdefault")
Set objItem = objWMIService.Get("SystemRestore")
errResults = objItem.CreateRestorePoint _
("Scripted restore", DEVICE_DRIVER_INSTALL, BEGIN_SYSTEM_CHANGE)
Using this small piece of Visual Basic for Applications code in Microsoft Outlook you can check the status of the out of office assistant. Normally I call this on the Item_Send evet. Which is a handy reminder to switch of your out of office assistant after your nice long holiday etc.
Public Sub checkoof()
Dim oCDO As MAPI.Session
Dim oStore As MAPI.InfoStore
Dim oFolder As MAPI.Folder
Dim strStoreID As String
Dim blnOOF As Boolean
Dim blnResult As Boolean Set oCDO = CreateObject("MAPI.Session")
oCDO.Logon "", "", False, False 'piggy-back logon
Set oFolder = oCDO.Inbox 'get default Inbox
strStoreID = oFolder.StoreID 'get default InfoStore.StoreID0
Set oStore = oCDO.GetInfoStore(strStoreID) 'get store
blnOOF = oStore.Fields(&H661D000B) 'get property
If blnOOF = True Then
blnResult = MsgBox("The out of office assistant is currently set, would you like to disable this?")
If blnResult = True Then
SendKeys "%{U}"
End If
End If
End Sub
Private Sub Application_Startup()
checkoof
End Sub
Public Sub checkoof()Dim oCDO As MAPI.SessionDim oStore As MAPI.InfoStoreDim oFolder As MAPI.FolderDim strStoreID As StringDim blnOOF As BooleanDim blnResult As Boolean Set oCDO = CreateObject("MAPI.Session")oCDO.Logon "", "", False, False 'piggy-back logonSet oFolder = oCDO.Inbox 'get default InboxstrStoreID = oFolder.StoreID 'get default InfoStore.StoreID0Set oStore = oCDO.GetInfoStore(strStoreID) 'get storeblnOOF = oStore.Fields(&H661D000B) 'get property
If blnOOF = True ThenblnResult = MsgBox("The out of office assistant is currently set, would you like to disable this?")If blnResult = True ThenSendKeys "%{U}"End IfEnd If
End Sub
Private Sub Application_Startup()
checkoof
End Sub
With this example, it’s possible to use the ‘WithEvents’ methods on a folder outside of your own mailbox.
This even works on Public Folders!
Dim WithEvents olkFolder As Outlook.MAPIFolder Sub InitMonitoring()
Set olkFolder = OpenOutlookFolder("Path to the folder to monitor")
End Sub
Function IsNothing(obj)
If TypeName(obj) = "Nothing" Then
IsNothing = True
Else
IsNothing = False
End If
End Function
Function OpenOutlookFolder(strFolderPath As String) As Outlook.MAPIFolder
Dim arrFolders As Variant, _
varFolder As Variant, _
olkFolder As Outlook.MAPIFolder
On Error GoTo ehOpenOutlookFolder
If strFolderPath = "" Then
Set OpenOutlookFolder = Nothing
Else
If Left(strFolderPath, 1) = "" Then
strFolderPath = Right(strFolderPath, Len(strFolderPath) - 1)
End If
arrFolders = Split(strFolderPath, "")
For Each varFolder In arrFolders
If IsNothing(olkFolder) Then
Set olkFolder = Session.Folders(varFolder)
Else
Set olkFolder = olkFolder.Folders(varFolder)
End If
Next
Set OpenOutlookFolder = olkFolder
End If
On Error GoTo 0
Exit Function
ehOpenOutlookFolder:
Set OpenOutlookFolder = Nothing
On Error GoTo 0
End Function
Outlook 2007 brought with it the all new ‘Ribbon Bar’ which has caused headaches to programmers the world over.
Now, using this code you can create a menu in Outlook. The menu, which contains one item, appears at the top of the application. When you click the menu item, the code displays a message that shows the menu item caption.
