Create New Event Log Source

Create a new console app and then paste this code. The resulting exe must be run as administrator, and you need to pass in the name of the source. You probably will want to create a cmd or bat file to run the exe.

using System;
using System.Diagnostics;

namespace CreateEventLogSource
{
    class Program
    {
        static void Main(string[] args)
        {
            if (args.Length == 1 && !String.IsNullOrWhiteSpace(args[0]))
            {
                string eventSource = args[0];
                if (EventLog.SourceExists(eventSource))
                {
                    Console.WriteLine("Event Log Source already exists");
                }
                else
                {
                    // No exception yet means the user has admin privileges
                    try
                    {
                        EventLog.CreateEventSource(eventSource, "Application");
                        Console.WriteLine("Event log source created.");
                    }
                    catch (Exception ex)
                    {
                        Console.WriteLine("An exception occurred during CreateEventSource. Details follow.");
                        Console.WriteLine(ex);
                        return;
                    }

                    try
                    {
                        EventLog.WriteEntry(eventSource, "Test", EventLogEntryType.Information);
                    }
                    catch (Exception ex)
                    {
                        Console.WriteLine("An exception occurred during WriteEntry. Details follow.");
                        Console.WriteLine(ex);
                        return;
                    }
                }
            }
            else
            {
                Console.WriteLine("You must pass in the name of the Event Log Source");
            }
        }
    }
}

Outlook VBA to run code when a task reminder occurs and help with cleanup timeout emails

The first 4 items below help cleanup emails that have been categorized as "timeout" emails sent from our web server.

Below, the Application_Reminder event handler will fire whenever a reminder occur.



Private WithEvents Items As Outlook.Items

Private Sub Application_Startup()
  Dim olApp As Outlook.Application
  Dim olNs As Outlook.NameSpace
  Set olApp = Outlook.Application
  Set olNs = olApp.GetNamespace("MAPI")
  Set Items = olNs.GetDefaultFolder(olFolderInbox).Items
End Sub

Private Sub Items_ItemAdd(ByVal Item As Object)
    'Debug.Print CStr(Now) & ": START: Items_ItemAdd"
    On Error GoTo ErrorHandler
    If TypeName(Item) = "MailItem" Then
        MoveTimeoutsFromInbox
    End If

ProgramExit:
  Exit Sub

ErrorHandler:
  MsgBox Err.Number & ": " & Err.Description
  Resume ProgramExit
End Sub

Public Sub MoveTimeoutsFromInbox()
    'Dim DeletedItemsFolder As Outlook.MAPIFolder
    Dim olNs As Outlook.NameSpace
    Dim Item As Object
    Dim InboxItems As Outlook.Items
    Dim MyMailItem As Outlook.MailItem
    Dim counter As Long
    Dim position As Integer
    Dim DateAWeekAgo As Date

    On Error GoTo ErrorInfo

    Set olNs = Application.GetNamespace("MAPI")
    'Set DeletedItemsFolder = olNs.GetDefaultFolder(olFolderDeletedItems)
    Set InboxItems = olNs.GetDefaultFolder(olFolderInbox).Items
    DateAWeekAgo = DateAdd("d", -7, Now())

    ' Loop through the Items in the folder backwards (most recent first)
    For counter = InboxItems.Count To 1 Step -1
        Set Item = InboxItems(counter)

        If Item.Class = olMail Then
            Set MyMailItem = Item

            If MyMailItem.SentOn < DateAWeekAgo Then
                Exit Sub ' If the email was sent over a week ago, stop processing because we've reached a week of emails
            End If

            ' If there is a category and the email was sent more than 75 minutes ago, move it to NoReply if it has Timeout category
            If MyMailItem.Categories <> "" Then
                Debug.Print CStr(Now) & ": MoveTimeoutsFromInbox: Mail has categories"
                position = InStr(MyMailItem.Categories, "Timeout")
                If position > 0 Then
                    Debug.Print "Timeout found. Minutes past since sent: " & CStr(DateDiff("n", MyMailItem.SentOn, Now()))
                    If MyMailItem.SentOn < DateAdd("n", -75, Now()) Then
                        Item.Move olNs.GetDefaultFolder(olFolderDeletedItems).Folders("NoReply")
                        Debug.Print "Timeout moved."
                    End If
                End If
            End If
        End If
    Next counter

ProgramExit:
    Set olNs = Nothing
    Set Item = Nothing
    Set InboxItems = Nothing

    Exit Sub

ErrorInfo:
    MsgBox "An unexpected Error has occurred." _
         & vbCrLf & "Error Number: " & Err.Number _
         & vbCrLf & "Error Description: " & Err.Description _
         , vbCritical, "Error!"
    Resume ProgramExit
End Sub

Public Sub Application_Reminder(ByVal Item As Object)
    If TypeOf Item Is Outlook.TaskItem Then
        Dim ReminderSubject As String
        Dim olTask As Outlook.TaskItem
        Set olTask = Item
        ReminderSubject = "Run Rule: noreply to Deleted Items - NoReply"

        'Run Rule: noreply to Deleted Items - NoReply
        Dim objRules As Outlook.Rules
        Set objRules = Outlook.Application.Session.DefaultStore.GetRules
   
        ' Refer to the subject of the specific task item
        If olTask.Subject = ReminderSubject Then
             ' The corresponding specific rule
             Dim objRule As Outlook.Rule
             Set objRule = objRules.Item("noreply to Deleted Items - NoReply")
             objRule.Execute ShowProgress:=True, Folder:=Session.GetDefaultFolder(olFolderDeletedItems), IncludeSubfolders:=False
             Set objRule = Nothing
             'MsgBox ("Deleted NoReply emails moved successfully")
        End If

        Set objRules = Nothing

        If LCase$(olTask.Subject) = LCase$(ReminderSubject) Then
            ' Set next reminder - "Snooze" for 5 hours
            olTask.ReminderTime = DateAdd("h", 5, olTask.ReminderTime)
            olTask.Save
        End If

        Set olTask = Nothing
    End If
End Sub