Code level: intermediate    Code area: Basic Outlook
Title: VBScript: Add Task
Description: 'Prompts user for input (syntax: "@category subject [project]:notes #duedate"), saves this as a task in Microsoft Outlook. 'Note this is a stand-alone file (not launched from inside Outlook), intended so you can quickly create a task without the distraction of opening/navigating Outlook.
Date: 13-Jul-2007  09:14
Code level: intermediate
Code area: Basic Outlook
Posted by: Bob Menke
Body:
'addnote.vbs
'Prompts user for input (syntax: "@category subject [project]:notes #duedate"), saves this as a task in Microsoft Outlook.

'Version History:
'v1.1 26Jun2007 Change input to be single InputBox using iGTD for Quicksilver syntax
'v1.0 20Jun2007 Release
'
' code credit: 	http://forums1.itrc.hp.com/service/forums/questionanswer.do?threadId=206579&admit=-682735245+1182363537802+28353475
' 			http://support.microsoft.com/kb/162371
' inspired by:	http://lifehacker.com/software/how-you-work/getting-things-done-with-igtd-270522.php

Option Explicit

Call Main

Sub Main ()

	Dim objApplication, objTask
	Dim strInput, strSubject, strStatus, StrDueDate, strPercentComplete, strCategories, _
        strBody, strPriority, strProject
	Dim intPos

   ' get user input
   ' syntax like iGTD for Quicksilver: http://microformats.org/wiki/igtd-syntax
   strInput = InputBox("Please enter your task:" + Chr(13) + Chr(13) + _
				"Example:" + Chr(13) + _
				"      @category subject [project]:notes #duedate" + Chr(13) + Chr(13) + _
				"Syntax: 1. Each argument is optional" + Chr(13) + _
				"             2. Argument order is mandatory" + Chr(13) + _
				"             3. Multiple categories are allowed" + Chr(13) + _
				"                (comma separated, no spaces)" + Chr(13) + _
				"             4. Due date is in MO/DA/YEAR format" + Chr(13) + _
				"             5. ! in subject is high priority, ? is low", _ 
				"Quick Add Task to Microsoft Outlook","")
   If Len(strInput)=0 Then Wscript.Quit 0

   ' parse user input

   ' category(s)
   intPos = InStr(strInput,"@")
   If intPos>0 Then
      strCategories = Mid(strInput,intPos+1,InStr(strInput," ")-(intPos+1))
	  strInput = Left(strInput,intPos-1) + Right(strInput,Len(strInput)-InStr(strInput," ")) 
   Else
      strCategories = ""
   End If

   ' due date
   intPos = InStr(strInput,"#")
   If intPos>0 Then
      strDueDate = Right(strInput,Len(strInput)-intPos)
	  strInput = Left(strInput,intPos-1)
   Else
      strDueDate = ""
   End If
   
   ' notes
   intPos = InStr(strInput,":")
   If intPos>0 Then
      strBody = Right(strInput,Len(strInput)-intPos)
	  strInput = Left(strInput,intPos-1)
   Else
      strBody = ""
   End If

   ' project
   intPos = InStr(strInput,"[")
   If intPos>0 Then
      strProject = Mid(strInput,intPos+1,InStr(strInput,"]")-(intPos+1))
	  strInput = Left(strInput,intPos-1) + Right(strInput,Len(strInput)-InStr(strInput,"]")) 
   Else
      strProject = ""
   End If

   ' priority
   strPriority = 1
   intPos = InStr(strInput,"!")
   If intPos>0 Then
      strPriority = 2
	  strInput = Left(strInput,intPos-1) + Right(strInput,Len(strInput)-intPos) 
   End If
   intPos = InStr(strInput,"?")
   If intPos>0 Then
      strPriority = 0
	  strInput = Left(strInput,intPos-1) + Right(strInput,Len(strInput)-intPos) 
   End If

   ' subject
   strSubject = StrInput

   ' other task defaults
   strStatus = 0
   strPercentComplete = 0
   
   ' start Outlook if installed
   Set objApplication = CreateObject ("Outlook.Application")

   ' create a new task item
   ' item types: http://msdn2.microsoft.com/en-us/library/bb208104.aspx
   Set objTask = objApplication.CreateItem (3)

   ' fill in the details
   With objTask
          ' all possible fields: http://msdn2.microsoft.com/en-us/library/bb176792.aspx
          .Subject = strSubject
		  .Status = strStatus '  0=not yet, 1=inprog, 2=complete, 3=waiting, 4=deferred
		  .Importance = strPriority ' 0=low, 1=normal, 2=high
          If Len(strDueDate)>0 Then
		      .DueDate = DateValue(strDueDate)
	          .ReminderSet = True
	          '.ReminderTime = DateAdd("n", 2, Now)
	          '.ReminderPlaySound = False
		  Else
		      .ReminderSet = False
		  End If
		  .PercentComplete = strPercentComplete
		  .Categories = strCategories ' comma seperated
          .Body = strBody
		  .Save

	   ' attempt to assign item to project
	   ' assumes Outlook project setup from: http://home.comcast.net/~whkratz/id3.htm
	   If (Len(strProject)>0) Then
			Dim myNameSpace, i, j, found
			found = False
			Set myNameSpace = objApplication.GetNameSpace("MAPI")
			For i = 1 To (myNameSpace.Folders.Count)
				For j = 1 To (myNameSpace.Folders(i).Folders.Count)
					If myNameSpace.Folders(i).Folders(j) = "Projects" Then
						found = True
						' search code credit: http://msdn2.microsoft.com/en-us/library/bb175245.aspx
						Dim myProject, myItems, strSearch
						strSearch = "[Full Name] = """ & strProject & """"
					    Set myItems = myNameSpace.Folders(i).Folders(j).Items.Restrict( _
										"[MessageClass] = 'IPM.Contact.Project'")
					    Set myProject = myItems.Find(strSearch)
						On Error Resume Next
						.Links.Add myProject
						.Save
						Set myItems = Nothing
						Set myProject = Nothing
						Exit For
					End If
				Next
				If found = True Then Exit For
			Next   
			Set myNameSpace = Nothing
	   End If

    End With
	
   ' display the new item to the user
   'objTask.Display

   ' destroy objects
   Set objTask = Nothing
   Set objApplication = Nothing
 
End Sub
All 1comments
Page [ 1  
  10-Nov-2007  19:17   
Very Nice, Bob. Thank YOU!

How would one modify the script to insert values in the mileage and billing fields? (I use the Mileage to insert info about my projects -- so I wanted to replace the strProject with strMileage --, and I use the billing field to use as an ABCD priority system; yep, hacking Outlook a bit...)

Of course I know nothing about VB. But, using common sense, I've tried adding a Mileage variable:

Dim strInput, strSubject, strStatus, StrDueDate, strPercentComplete, strCategories, _
       strBody, strPriority, strProject, strMileage

 and then I "commented out" the project section and added this section :

  ' Mileage(s)
  intPos = InStr(strInput,"[")
  If intPos>0 Then
     strMileage = Mid(strInput,intPos+1,InStr(strInput,"]")-(intPos+1))
 strInput = Left(strInput,intPos-1) + Right(strInput,Len(strInput)-InStr(strInput,"]"))
  Else
     strMileage = ""
  End If


But... It doesn't work. So I'm obviously not doing this right. :)

Thank you in advance for any hint!

Menez
 
Page [ 1