Outlook: clear task due dates

I really like Outlooks 2007's task list features. However, I have some resistance to being told to do things "TODAY, like RIGHT NOW!!! SEE??? I put the task in RED in your task list!! Now you MUST do it!!"

Yeah, that? Not my favorite part.

So, I wrote a macro to adjust the dates in Outlook, so they don't turn red automatically.

Sub BlankDueDates()
On Error Resume Next
  Dim ns As NameSpace
  Dim fld As Folder
  Dim task As TaskItem
  Dim items As Outlook.items
  Dim rest As Outlook.items
  Dim filterSQL As String
  Dim i As Integer
  i = 0
  Set ns = Application.GetNamespace("MAPI")
  Set fld = ns.GetDefaultFolder(olFolderTasks)
  Set items = fld.items
  Set rest = items.Restrict("[Status] <> 'Completed'")
  For Each task In rest
      If task.DueDate <> "1/1/4501" Then
          task.DueDate = "1/1/4501"
          task.Save
      End If
      i = i + 1
  Next

  For Each task In rest
      If task.Importance <> olImportanceNormal Then
          task.Importance = olImportanceNormal
          task.Save
      End If
  Next
  MsgBox ("Done")

  Set ns = Nothing
  Set fld = Nothing
  Set task = Nothing
  Set items = Nothing
  Set rest = Nothing

End Sub

Outlook: Cleaning up contacts

I love my BlackBerry.

I hate manually cleaning up after the fact when it snargleblatts itself inside Outlook.

Here's a quick-and-dirty macro I wrote to clean up after it snargleblatted my contact list by adding the string "(Home)" and "(Work)" to the names of some of my contacts without asking.

Sub AdjustContactName()
On Error Resume Next
  Dim ns As NameSpace
  Dim fld As Folder
  Dim contact As ContactItem
  Dim items As Outlook.items
  Dim i As Integer
  i = 0
  Dim changeflag As Boolean
  changeflag = False

  Set ns = Application.GetNamespace("MAPI")
  Set fld = ns.GetDefaultFolder(olFolderContacts)
  Set items = fld.items
  For Each contact In items
      If InStr(1, contact.FullName, "(Home)") Then
          contact.FullName = Replace(contact.FullName, "(Home)", "")
          changeflag = True
          i = i + 1
      End If
    
      If InStr(1, contact.FullName, "(Work)") Then
          contact.FullName = Replace(contact.FullName, "(Work)", "")
          changeflag = True
          i = i + 1
      End If
    
      If InStr(1, contact.FileAs, "(Home),") Then
          contact.FileAs = Replace(contact.FileAs, "(Home),", "")
          changeflag = True
          i = i + 1
      End If
    
      If InStr(1, contact.FileAs, "(Work),") Then
          contact.FileAs = Replace(contact.FileAs, "(Work),", "")
          changeflag = True
          i = i + 1
      End If
    
      If changeflag Then
          contact.Save
          changeflag = False
      End If
  Next

  MsgBox ("Done." + vbCrLf + "Counted: " + CStr(i))

  Set ns = Nothing
  Set fld = Nothing
  Set contact = Nothing
  Set items = Nothing

End Sub