Ok, here it goes. Note that there is no warranty, express or implied (so save your stuff before you try this
1.This is the code you want to paste, somewhere, into VBA[/i]
Option Explicit
Function GetSettingByName(ByVal settingName As String) As String
Dim myNamespace As NameSpace
Dim currentFolder As MAPIFolder
Dim currentMail As Object
Dim hasSettings As Boolean
Dim parentFolder As MAPIFolder
On Error GoTo GetSettingsByName_Error
hasSettings = False
Set myNamespace = Application.GetNamespace("MAPI")
Set parentFolder = myNamespace.Folders("Mailbox - Furash Gary")
Debug.Print parentFolder.Name
For Each currentFolder In parentFolder.Folders
If currentFolder.Name = "Settings" Then
For Each currentMail In currentFolder.items
If currentMail.Subject = settingName Then
GetSettingByName = currentMail.body
hasSettings = True
End If
Next
If hasSettings Then
Exit For
End If
End If
Next currentFolder
Set currentFolder = Nothing
Set currentMail = Nothing
Set myNamespace = Nothing
If hasSettings = False Then
Err.Raise "9999", "GetSettingsByName", "Could not find settings"
End If
Exit Function
GetSettingsByName_Error:
If Err.Number = 13 Then
Resume Next
End If
End Function
Sub GenerateTaskList(ByVal xmlText As String)
Dim xmlDoc As New MSXML2.DOMDocument50
Dim items As IXMLDOMNodeList
Dim itemNode As IXMLDOMNode
Dim newTask As Outlook.TaskItem
Dim itemPart As IXMLDOMNode
Dim listName As String
Dim prop As UserProperty
Dim i As Integer
On Error GoTo GenerateTaskList_Error
With xmlDoc
.async = False
.loadXML xmlText
With .parseError
If .errorCode <> 0 Then
Err.Raise "1001" + .errorCode, "GenerateTaskList in Module mdlOutlookUtil", .reason + Chr$(10) + Chr$(13) + .srcText
End If
End With
End With
listName = xmlDoc.selectSingleNode("/Checklist/Name").Text
Set items = xmlDoc.selectNodes("/Checklist/Tasks/Item")
i = 0
For Each itemNode In items
i = i + 1
Set newTask = Application.CreateItem(olTaskItem)
With newTask
For Each itemPart In itemNode.childNodes
Select Case itemPart.baseName
Case "Subject"
.Subject = i & ". " & itemPart.Text
Case "Categories"
.categories = itemPart.Text
Case "Body"
.body = itemPart.Text
End Select
Next itemPart
.UserProperties.Add("Checklist", olText) = listName
.UserProperties.Add("Action", olText) = .categories
.DueDate = Date
.Save
End With
Set newTask = Nothing
Next itemNode
MsgBox "Tasks for checklist " & listName & " created", vbOKOnly, "mdlOutlookUtil"
Exit Sub
GenerateTaskList_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure DailyDisciplines of Module Utilities"
End Sub
Function DeleteChecklistTasks(ByVal listName As String) As Integer
Dim folderSet As NameSpace
Dim taskFolder As MAPIFolder
Dim task As TaskItem
Dim openItems As Object
Dim property As UserProperty
Set folderSet = Application.GetNamespace("MAPI")
Set taskFolder = folderSet.GetDefaultFolder(olFolderTasks)
For Each task In taskFolder.items
If task.Complete = False Then
Set property = task.UserProperties.Find("Checklist")
If TypeName(property) <> "Nothing" Then
If property.Value = listName Then
task.Delete
End If
End If
End If
Next task
Set folderSet = Nothing
Set taskFolder = Nothing
End Function
Sub UpdateTaskPriorities()
Dim folderSet As NameSpace
Dim taskFolder As MAPIFolder
Dim task As TaskItem
Dim openItems As Object
Dim property As UserProperty
Set folderSet = Application.GetNamespace("MAPI")
Set taskFolder = folderSet.GetDefaultFolder(olFolderTasks)
For Each task In taskFolder.items
If task.Complete = False Then
If InStr(1, task.categories, "Someday") Then
task.Importance = olImportanceLow
ElseIf task.DueDate > (DateAdd("d", -7, Date)) Then
task.Importance = olImportanceHigh
Else
task.Importance = olImportanceNormal
End If
End If
Next task
MsgBox "Task priorities updated", vbOKOnly, "mdlOutlookUtil"
Set folderSet = Nothing
Set taskFolder = Nothing
End Sub
Sub GenerateWordTaskLists()
Dim wordApp As Word.Application
Dim taskList() As String
Dim i As Integer
taskList = GetTaskSubjectsByCategory("@Home")
If UBound(taskList) > 0 Then
Set wordApp = CreateObject("Word.Application")
wordApp.Documents.Add
i = 0
wordApp.Selection.Font.Size = 11
While i <= UBound(taskList)
wordApp.Selection.TypeText taskList(i) & Chr(10)
i = i + 1
Wend
wordApp.ActiveDocument.SaveAs fileName:="@Home.doc"
wordApp.Quit
Set wordApp = Nothing
End If
End Sub
2. Make sure you have a folder off your root tree called "Settings". GTD will create one for you if you have the add-in for outlook
3. Then, create a "new post" in that folder. Call the subject whatever you want (e.g., "!DailyDisciplines") and create something like the following in the body of the message to yourself
<?xml version="1.0" encoding="UTF-8"?>
<Checklist>
<Name>!DailyChecklist</Name>
<Tasks>
<Item><Subject>1/2 Hour of "Sun Certified Programmer and Developer for Java 2"</Subject><Categories>@Anywhere</Categories></Item>
<Item><Subject>Brainstorm and Organize 1-2 Projects</Subject><Categories>@Computer</Categories></Item>
<Item><Subject>Jogging or Calesthenics</Subject><Categories>@Home</Categories></Item>
<Item><Subject>Review Track-IT calls assigned to Applications or assigned to Gary Furash</Subject><Categories>@Office</Categories></Item>
<Item><Subject>Review Newly Updated Mantis items, Emergencies, and Incidents</Subject><Categories>@Office</Categories></Item>
<Item><Subject>Action Items: Review the calendar: what must be done today/tomorrow at a specific time or any time</Subject><Categories>@Computer</Categories></Item>
<Item><Subject>Action Items: Review "@WaitingFor" and "@Agenda"</Subject><Categories>@Computer</Categories></Item>
<Item><Subject>Check in with each team member (MBWA)</Subject><Categories>@Office</Categories></Item>
<Item><Subject>Note Daily Accomplishment</Subject><Categories>@Computer</Categories></Item>
</Tasks>
</Checklist>
You put in one "<item>" row for each of your items. Each item has to have a subject and a category, and can have a "Body"
4. You just need to make a snippet of code for each of your checklists, like the following
Sub MakeDailyChecklist()
DeleteChecklistTasks "!DailyChecklist"
GenerateTaskList GetSettingByName("!DailyChecklist")
End Sub
Sub MakeWeeklyChecklist()
DeleteChecklistTasks "!DailyChecklist"
GenerateTaskList GetSettingByName("!WeeklyChecklist")
End Sub
5. You can then run them via alt-f8 or use Hyatt's great explanation for how to set up a button
I plan to clean this up a bit so you can choose, from a drop down, dynamically, which checklists you want to autobuild and maybe a few othre features. Also, I need to clean up the search function - rather than looping through all of the tasks, I need to do a Find/Next.
Note that if you use the add-in, it will put the <category> tag contents into both categories and action.