Mass Outlook Calendar Cleanup

May 25, 2013May 18, 2014 Mike Hudson Leave a comment

Over the last few weeks the company that I work for have been migrating from Google Apps over to Microsoft 365 for mail/calendar/contacts and unified messaging etc. This has not been without it’s challenges. Some have which have been fairly bizarre. This week I was approached by a member of our department who had somehow managed to end up with 10,000+ appointments of the same title in his calendar. We set about trying to remove them on mass using the Outlook GUI, but soon realised this would take a very long time. Which is when I put together the following snippet of VBA:

NB: This code ‘takes no prisoners, and straight deletes the appointments matching the criteria you pass it. This wouldn’t be easy to undue if you ran with incorrect parameters. I’d advise adding a break point and testing a few before letting it hit your entire calendar folder.

Dim myNameSpace As NameSpace
Dim myCalendar As Folder
Dim myAppts As Items
Dim myAppt As AppointmentItem
Dim i As Integer

Sub purge_cal()
    Set myNameSpace = Outlook.Application.GetNamespace("MAPI")
    Set myCalendar = myNameSpace.GetDefaultFolder(olFolderCalendar)

    Set myAppts = myCalendar.Items
    i = 0
    For Each myAppt In myAppts
        If myAppt.Subject = "" Then
            i = i + 1
            Debug.Print "Deleting " & myAppt.Subject
            myAppt.Delete

        End If
    Next
        Debug.Print i & " calendar items deleted"
End Sub

Delay Outlook mail sending

February 4, 2012May 18, 2014 Mike Hudson 14 Comments

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

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

Create a system restore point VBScript

December 26, 2008May 18, 2014 Mike Hudson Leave a comment

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:" _
&amp; "{impersonationLevel=impersonate}" &amp; strComputer &amp; "rootdefault")
Set objItem = objWMIService.Get("SystemRestore")
errResults = objItem.CreateRestorePoint _
("Scripted restore", DEVICE_DRIVER_INSTALL, BEGIN_SYSTEM_CHANGE)

' 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)

Check out of office status VBA

December 26, 2008May 18, 2014 Mike Hudson Leave a comment

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(&amp;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(&amp;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

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 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

Monitor a folder for changes in outlook

December 24, 2008May 15, 2014 Mike Hudson Leave a comment

Sometimes, you may want to fire rules or perform functions on the arrival of an item in a folder inside Microsoft Outlook. The built in rules wizard is pretty powerful and useful in these situations, however it doesn’t work with folders outside of your mailbox.

With this example, it is possible to use the ‘WithEvents’ method on a folder outside of your own mailbox.

This even works on Public Folders!

<!DOCTYPE html>
<html>
  <head>
    <meta http-equiv="Content-type" content="text/html; charset=utf-8">
    <title>Server Error &middot; Gist</title>
    <style type="text/css" media="screen">
      body {
        background: #f1f1f1;
        font-family: "HelveticaNeue-Light", Helvetica, Arial, sans-serif;
        text-rendering: optimizeLegibility;
        -webkit-font-smoothing: antialiased; }

      .container { margin: 100px auto; width: 600px; text-align: center; }

      a { color: #4183c4; text-decoration: none; }
      a:visited { color: #4183c4 }
      a:hover { text-decoration: none; }

      h1 { letter-spacing: -1px; line-height: 60px; font-size: 60px; font-weight: 100; margin: 0px; text-shadow: 0 1px 0 #fff; }
      p { color: rgba(0, 0, 0, 0.5); margin: 20px 0 40px; }

      ul { border-top: 1px solid #ccc; list-style: none; margin: 20px 0; padding: 20px 0; }
      li { display: table-cell; font-weight: bold; width: 1%; }
    </style>
  </head>
  <body>
    <div class="container">
      <h1>OH NOES, 404.</h1>
      <p>We seem to have missed the <em>gist</em> of that <em>gist</em> you were looking for.</p>
      <ul id="error-suggestions">
          <li><a href="https://github.com/contact">Contact Support</a></li>
          <li><a href="https://status.github.com">Status Site</a></li>
          <li><a href="https://twitter.com/github">@github</a></li>
      </ul>
      <p><img src="https://github.s3.amazonaws.com/media/maint-logo.png" alt="GitHub"></p>
    </div>
  </body>
</html>

Welcome to MikeSel.info

Operating System How To's

Programming How To's

CMS How To's

Security How To’s

Home Automation

VBA

Mass Outlook Calendar Cleanup

Delay Outlook mail sending

Create a system restore point VBScript

Check out of office status VBA

Monitor a folder for changes in outlook