Forum

  • If you are new to these Forums, please take a moment to register using the fields above.

Announcement

Announcement Module
Collapse
No announcement yet.

"Linking" mindmaps to GTD projects in outlook

Page Title Module
Move Remove Collapse
X
Conversation Detail Module
Collapse
  • Filter
  • Time
  • Show
Clear All
new posts

  • "Linking" mindmaps to GTD projects in outlook

    I sometimes use mindmaps on my GTD projects where I feel I need to plan the project out. I created this macro, and then a create a button on my tasks that allows me to create/open a project mindmap from any Outlook task that is part of a GTD project. You will have to customize a couple of values (where you store your maps on your PC for instance), but this may be of use to some folks.

    Create a new VBA module in Outlook for this code. Next add these lines to the top of the new module:

    Option Explicit

    Private Const MindMapFolderPath = "C:\Documents and Settings\REW05\My Documents\My Maps\"

    Private Const MindMapTemplate = "C:\Documents and Settings\REW05\My Documents\My Maps\GTD Templates\GTD Template.mmap"

    The first variable is the directory where I store all my mindmaps. The second variable is the storage location and the name of a mindmap template I use for every GTD project. This map has one branch attached with three nodes:

    Base Node: Vision
    Branch 1: Vision: What does wildly successfull look like?
    Branch 2: Completion: What does completion look like
    Branch 3: Resources: What people, dollars, etc do I need to complete this project?


    Add these macros:

    Function GetProjectName() As String

    Dim itmTask As Outlook.TaskItem
    Dim objProperty As UserProperty
    Dim projectName As String
    Dim i As Integer

    If ActiveInspector.CurrentItem.Class = 48 Then
    Set itmTask = ActiveInspector.CurrentItem
    GetProjectName = ""

    Set objProperty = itmTask.UserProperties.Find("Project")

    If Not objProperty Is Nothing Then
    GetProjectName = itmTask.UserProperties("Project")
    End If
    End If

    GotTheProjectName:
    End Function

    Sub OpenProjectMM()

    On Error GoTo Err_OpenProjectMM

    Dim strMindMapName As String
    Dim folderPathName As String
    Dim projectName As String
    Dim fileExists As Boolean
    Dim fso 'As FileSystemObject

    Dim itmTask As Outlook.TaskItem
    Dim objProperty As UserProperty

    If ActiveInspector.CurrentItem.Class = 48 Then
    Set itmTask = ActiveInspector.CurrentItem
    Else
    Exit Sub
    End If

    Set objProperty = itmTask.UserProperties.Find("MindMap")

    If Not objProperty Is Nothing Then
    strMindMapName = itmTask.UserProperties("MindMap")
    Navigate (strMindMapName)
    Exit Sub
    End If

    strMindMapName = MindMapFolderPath

    projectName = GetProjectName()
    Set fso = CreateObject("Scripting.FileSystemObject")

    If projectName = "" Then
    GoTo Exit_OpenProjectMM
    End If

    strMindMapName = strMindMapName + projectName + ".mmap"

    fileExists = (Len(Dir(strMindMapName)) > 0)

    If fileExists Then
    itmTask.UserProperties.Add("MindMap", olText) = strMindMapName
    Navigate (strMindMapName)
    Else
    If (vbNo = MsgBox("No mindmap " + strMindMapName + " exists! Create a default MindMap?", vbYesNo)) Then
    GoTo Exit_OpenProjectMM
    End If

    If (fso.CopyFile(MindMapTemplate, strMindMapName)) Then
    MsgBox ("Error creating MindMap!")
    Else
    Navigate (strMindMapName)
    End If
    End If

    Exit_OpenProjectMM:
    Exit Sub

    Err_OpenProjectMM:
    MsgBox Err.Description
    Resume Exit_OpenProjectMM

    End Sub



    I use Outlook 2003, MindManager Professional 6, and the newest Netcentrics GTD application, and it works for these versions, your mileage may vary...

    Roger Wichmann

  • #2
    The rest of the story....

    Sorry, I forgot a little bit of code to make this all work...

    Private Declare Function ShellExecute Lib _
    "shell32.dll" Alias "ShellExecuteA" _
    (ByVal hwnd As Long, _
    ByVal lpOperation As String, _
    ByVal lpFile As String, _
    ByVal lpParameters As String, _
    ByVal lpDirectory As String, _
    ByVal nShowCmd As Long) As Long

    Private Const SW_SHOW = 1

    Declare Function SHGetFolderPath Lib "shell32.dll" Alias "SHGetFolderPathA" _
    (ByVal hwndOwner As Long, ByVal nFolder As Long, ByVal hToken As Long, _
    ByVal dwFlags As Long, ByVal lpszPath As String) As Long

    Private Const S_OK = &H0
    Private Const S_FALSE = &H1
    Private Const E_INVALIDARG = &H80070057
    Private Const SHGFP_TYPE_CURRENT = 0
    Private Const SHGFP_TYPE_DEFAULT = 1
    Private Const CSIDL_PERSONAL = &H5

    Public Sub Navigate(ByVal NavTo As String)
    Dim hBrowse As Long
    hBrowse = ShellExecute(0&, "open", NavTo, "", "", SW_SHOW)
    End Sub


    Put this in the same module...

    Comment


    • #3
      macro code

      Roger, I'm having trouble piecing this all together, so it isn't working properly. Could you please post the whole macro together in form that works for you?
      thanks
      Jim

      Comment


      • #4
        Roger,

        Can't seem to get it to work, the error seems to resolve around the Dim fso As line. Any thoughts?

        Lars

        Comment


        • #5
          fso (FileSystemObject)

          Check to see if you have the .net framework installed. I haven't run the code but that should clear up the fso (FileSystemObject) error.

          Comment

          Working...
          X