Category : Scripting

Scripting Active Directory

I seem to have been dong a lot of scripting work recently – I really should be using PowerShell, but I had limited time to get this stuff done and it needed to pretty generic / simple as it would be implemented by others (some with limited knowledge of scripting / coding)..

Anyway, the requirement was to ‘shlurp’ all the users from areas of Active Directory for use with one of our products. I wanted to get all users in specific AD containers into a dictionary object so that I could use them later…

The containers I looked at were :-

  • Organizational Units (OUs) – needed to be recursive to pull in sub OUs
  • Distribution Lists (DLs) – also needed to be recursive to pull in sub DLs
  • Query Based Distribution Lists
  • Users with a mailbox on a particular server.

The code is below. One of the keys to this is using LDP.exe to get the LDAP DNs for the various containers/lists….

 

Set objDictionary = CreateObject("Scripting.Disctionary")
GetAllMembersFromOU "OU=Reading,OU=UK,DC=YOURDOMAIN,DC=COM", objDictionary
GetAllMembersFromDL "DN=UK_Sales,OU=UK,DC=YOURDOMAIN,DC=COM", objDictionary
GetAllMembersFromQueryBasedDL "DN=CRMUsers,OU=UK,DC=YOURDOMAIN,DC=COM", objDictionary

strHomeServer = "/o=ABC Systems/ou=First Administrative Group/cn=Configuration/cn=Servers/cn=EX-01"
GetAllMembersFromServer strHomeServer, objDictionary
' Write the found users out to a text file
WriteDictionaryToTextFile objDictionary, "c:ad_users.txt"

‘ BELOW ARE THE FUNCTIONS THAT DO THE WORK

 
'******************************************************************
' GetAllMembersFromOU
'
' Gets all the members of an OU (including sub OUs) and adds them to a dictionary object
'
' sDN - a string containing the DN of the OU to start from (e.g. "LDAP://OU=Reading,OU=UK,DC=YOURDOMAIN,DC=COM")
' dic - a 'Scripting.Dictionary' object that you want to hold all the objects in.
'
'
' Ken Hughes 10 July 2007
'******************************************************************
Function GetAllMembersFromOU(sDN, dic)

    Set objOU = GetObject("LDAP://" & sDN)

    For each objMember in ObjOU

        Select Case LCase(objMember.Class)

            case "organizationalunit"
                GetAllMembersFromOU objMember.ADSPath, dic

            case "user"
                AddUserToDictionary dic, objMember

            case else
                ' do nothing it was a strange class

        End Select

    Next

End Function


'******************************************************************
' GetAllMembersFromDL
'
' Gets all the members of a distribution list (including sub DLs) and adds them to a dictionary object
'
' sDN - a string containing the DN of the OU to start from (e.g. "LDAP://OU=Reading,OU=UK,DC=YOURDOMAIN,DC=COM")
' dic - a 'Scripting.Dictionary' object that you want to hold all the objects in.
'
'
' Ken Hughes 10 July 2007
'******************************************************************
Function GetAllMembersFromDL(sDL, dic)

    Set objOU = GetObject("LDAP://" & sDL)

    For each objMember in ObjOU.Members

        Select Case LCase(objMember.Class)

            case "group"
                GetAllMembersFromDL objMember.ADSPath, dic

            case "user"
                AddUserToDictionary dic, objMember

            case else
                ' do nothing it was a strange class

        End Select

    Next

End Function


'******************************************************************
' GetAllMembersFromServer
'
' Gets all the users who have mailboxes homed on a particular server
'
' sDN - a string containing the msExchHomeServerName 
' (e.g. "LDAP:///o=ABC Systems/ou=First Administrative Group/cn=Configuration/cn=Servers/cn=EX-01") ' dic - a 'Scripting.Dictionary' object that you want to hold all the objects in. ' ' ' Ken Hughes 10 July 2007 '******************************************************************
Function GetAllMembersFromServer(sDN, dic) set conn = createobject("ADODB.Connection") Set iAdRootDSE = GetObject("LDAP://RootDSE") strDefaultNamingContext = iAdRootDSE.Get("defaultNamingContext") Conn.Provider = "ADsDSOObject" Conn.Open "ADs Provider" strQueryDL = "<LDAP://" & strDefaultNamingContext & ">;(&(msExchHomeServerName=" & sDN
strQueryDL = strQueryDL & ")(objectCategory=person)(objectClass=user));distinguishedName,adspath;subtree" set objCmd = createobject("ADODB.Command") objCmd.ActiveConnection = Conn objCmd.Properties("SearchScope") = 2 ' we want to search everything objCmd.Properties("Page Size") = 500 ' and we want our records in lots of 500 objCmd.CommandText = strQueryDL Set objRs = objCmd.Execute While Not objRS.eof Set objMember = GetObject("LDAP://" & replace(objRS.Fields("distinguishedName"),"/","/")) Select Case LCase(objMember.Class) case "user" AddUserToDictionary dic, objMember case else ' do nothing it was a strange class End Select objRS.MoveNext Wend End Function '****************************************************************** ' GetAllMembersFromQueryBasedDL ' ' Gets all the members of a query based distribution list ' ' sDN - a string containing the DN of the QBDL (e.g. "LDAP://DL=AdminUsers,OU=Reading,OU=UK,DC=YOUROMAIN,DC=COM") ' dic - a 'Scripting.Dictionary' object that you want to hold all the objects in. ' ' ' Ken Hughes 10 July 2007 '****************************************************************** Function GetAllMembersFromQueryBasedDL(sDN, dic) set conn = createobject("ADODB.Connection") Set iAdRootDSE = GetObject("LDAP://RootDSE") strDefaultNamingContext = iAdRootDSE.Get("defaultNamingContext") Conn.Provider = "ADsDSOObject" Conn.Open "ADs Provider" Set objQBDL = GetObject("LDAP://" & sDN) strQueryDL = "<LDAP://" & objQBDL.msExchDynamicDLBaseDN & ">;" & objQBDL.msExchDynamicDLFilter
strQueryDL = strQueryDL & ";mail,ObjectClass,distinguishedName,displayname,legacyExchangeDN,homemdb;subtree" set objCmd = createobject("ADODB.Command") objCmd.ActiveConnection = Conn objCmd.Properties("SearchScope") = 2 ' we want to search everything objCmd.Properties("Page Size") = 500 ' and we want our records in lots of 500 objCmd.CommandText = strQueryDL Set objRs = objCmd.Execute While Not objRS.eof Set objMember = GetObject("LDAP://" & replace(objRS.Fields("distinguishedName"),"/","/")) Select Case LCase(objMember.Class) case "user" AddUserToDictionary dic, objMember case else ' do nothing it was a strange class End Select objRS.MoveNext Wend End Function

'****************************************************************** ' WriteDictionaryToTextFile ' ' Writes the contents of a dictionary object to a text file ' ' objDic - a 'Scripting.Dictionary' object that holds all the objects you want written to the file ' fileName - a string containing the name of the file you want the objects written out to. ' ' ' Ken Hughes 10 July 2007 '****************************************************************** Sub WriteDictionaryToTextFile(objDic, fileName) Dim objFSO, objFile Const forReading = 1 Const forWriting = 2 Const forAppending = 8 Set objFSO = CreateObject("Scripting.FileSystemObject") Set objFile = objFSO.OpenTextFile(filename, forWriting, True) For Each obj in objDic.Keys objFile.Writeline obj Next objFile.Close Set objFile = Nothing Set objFSO = Nothing End Sub

GEO 51.4043197631836:-1.28760504722595


Consuming SOAP Web Services from VBScript

I spent a day this past week visiting one of our Technology Partners in New Jersey. The objective was do put together a proof concept for some integration we are planning.

We have some very cool stuff, about to be announced at one of the big shows coming up and the integration is around this new stuff. Anyway one of the things we had to do was to connect to a Web Service that returned complex types from a dynamic language.

I chose VBScript as the language because it’s widely available and can be executed on virtually any windows machine. I also wanted to ensure we only used commonly available (installed) ActiveX objects. The other constraint was the Web Services only used SOAP and HTTP POSTs, no HTTP GET support.

So the work involved was to :

  1. Create an XMLHTTP object
  2. Create the SOAP Body
  3. Send it to the Web Service
  4. Parse the results

Below is how we went about it.
It is messy and pretty horrible text manipulation to generate the SOAP bodies etc, but it is the only way I found from scripting..

Let me know if you have better / easier methods…

 

Const URL = "http://www.domain.com/folder/service.asmx"
Const nsUrl = "http://www.domain.com/namespace-name"


' Create the http request text
Dim strSoapReq
strSoapReq = GenerateSoapBodyStart()
strSoapReq = strSoapReq + GenerateSoapFunctionCallStart("WebServiceFunctionName")
strSoapReq = strSoapReq + GenerateSoapParameter("paramName1", paramValue1)
strSoapReq = strSoapReq + GenerateSoapParameter("paramName2", paramValue2)
strSoapReq = strSoapReq + GenerateSoapFunctionCallEnd("WebServiceFunctionName")
strSoapReq = strSoapReq + GenerateSoapBodyEnd()

Dim oHttp
Dim strResult
Set oHttp = CreateObject("Msxml2.XMLHTTP")
oHttp.open "POST", URL, false
oHttp.setRequestHeader "Content-Type", "text/xml"
oHttp.setRequestHeader "SOAPAction", URL + "WebServiceFunctionName"
oHttp.send strSoapReq
strResult = oHttp.responseText

' parse XML in strResult




Function GetResult(byval responseText, byval resultParam)

    Dim oXml
    Set oXml = CreateObject("Msxml2.DOMDocument")
    oXml.Async = true
    oXml.LoadXml responseText

    Dim strPath
    strPath = "/*/*/*/" + resultParam
    Dim oNode
    Set oNode = oXml.documentElement.SelectSingleNode(strPath)
    GetResult = oNode.Text

End Function


Function GenerateSoapBodyStart()

    Dim strSoap
    strSoap = "<?xml version=""1.0"" encoding=""utf-8""?>"
    strSoap = strSoap + "<soap12:Envelope "
    strSoap = strSoap + "xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"" "
    strSoap = strSoap + "xmlns:xsd=""http://www.w3.org/2001/XMLSchema"" "
    strSoap = strSoap + "xmlns:soap12=""http://www.w3.org/2003/05/soap-envelope""> "
    strSoap = strSoap + "<soap12:Body>"
    GenerateSoapBodyStart = strSoap

End Function

Function GenerateSoapBodyEnd()

    Dim strSoap
    strSoap = "</soap12:Body>"
    strSoap = strSoap + "</soap12:Envelope>"
    GenerateSoapBodyEnd = strSoap

End Function

Function GenerateSoapFunctionCallStart(byval strFunction)

    Dim strSoap
    strSoap = "<" + strFunction + " xmlns=""" + nsUrl + """>"
    GenerateSoapFunctionCallStart = strSoap

End Function

Function GenerateSoapFunctionCallEnd(byval strFunction)

    Dim strSoap
    strSoap = "</" + strFunction + ">"
    GenerateSoapFunctionCallEnd = strSoap

End Function

Function GenerateSoapParameter(byval strParam, byval strValue)

    Dim strSoap
    strSoap = "<" + strParam + ">"
    strSoap = strSoap + strValue
    strSoap = strSoap + "</" + strParam + ">"
    GenerateSoapParameter = strSoap

End Function

 

Fair Lawn, NJ – 40.9381556054652:-74.132137298584

Automating Installs

I was spending far too much time installing OS’s – virtual machines, lab machines etc.

Unattended In order to automate / streamline this I wanted to look at not just the Windows tools as well as other options. Remote Installation Service (RIS) and unattended.txt files go so far, but during my investigations I came across ‘Unattended‘. This open source tool takes unattended.txt, mixes in silent installs for hundreds of other common applications and supercharges the whole lot…

So the deal is, you extract some files from 4 zip archives, configure a DNS alias, share the folder, copy over the i386 folder from your OS CD/DVD, burn an ISO (or create a boot disk) image and your done – 25 minutes end to end.

The boot CD/Disk loads some network drivers, maps a Z drive to ‘ntinstallinstall’ (the machine and share with the files and OS on it) and passes control to a bunch of Perl scripts, these ask some questions from which it creates an unattended.txt file and executes the OS install (reboots and all). When the install completes it can also (optionally) run silent installers for other applications (Office, Open Office, Acrobat Reader, PDF Creator, Visual Studio, Perl etc..) as well as Windows Updates and critical fixes (they keep an up-to-date list on the homepage).

So, in summary, after booting from the install CD then 2 minutes of console based questions I can leave things for an hour or two and come back to a fully installed Windows OS, office applications, sales tools, developer tools – whatever. The scripts that install the additional apps are customizable (you can even enter your product keys) and you can build up suites from individual scripts (so I can have a script to install Visual Studio, another for the MSDN library, another for each of the various developer tools and then I can combine them all into a ‘developer_machine’ script…

Have a look – if you are doing more than one install (even just two) then this can save you time…

Immersing myself in PowerShell

PowerShell has been around for some time now, what with betas and CTPs. For (the released version of) Vista it became available a month or so ago.

It’s been on my ‘must get to grips with’ list for a while now and I’ve kinda been following some blogs about it, slowly getting a little knowledge here and there.

Mr Hanselman (the oracle for all things technical) has done a couple of podcasts on it and I listened a couple of weeks ago to an episode of Hanselminutes where he interviewed Bruce Payette. Bruce is the language architect for PowerShell and has just (2 weeks ago) released a book on it (Windows PowerShell in Action).

Bought the book last week in the US and have had it open ever since. Everything I do, I now do with a rosy PowerShell perspective. The only way (I find) to really to get to grips with something is to completely immerse yourself in it – think in it, live it, breathe it….

Today I have been updating the server side file for our Archive One (email archiving for Exchange) auto update feature (we’re just released V5.0 SR1, so the build numbers that are checked have changed). It’s a simple XML file that is parsed for ‘GA’ release version (ProdVer) and ‘HF’ version (hotfix). It looks like this (sample only):

<?xml version="1.0"?> <Versions> <AOnePolService ProdVer="5.0.0.1643" HotFix="5.0.0.1643"></AOnePolService> <AOneCmplService ProdVer="4.3.0.1077" Hotfix="4.3.0.1094"></AOneCmplService> </Versions>

I wanted to provide a quick and easy way to find the latest version of each products. I came up with the following PowerShell one liner (split over three lines for readability):

([XML] (new-object ("net.webclient")).Downloadstring(
"http://support.c2c.com/versioncheck/currentversions.xml")).versions.get_ChildNodes() |
% { "" } { $_.psbase.Name + "`t GA=" + $_.prodver + "`t HF=" + $_.hotfix } { "" }

Downloads the xml file, parses it and lists out the product, GA version and HF version

Watch this space for some Active Directory related stuff as I have been very active in scripting AD over the past few days and am in the process of porting it to PowerShell.

Outlook RSS and downloading podcasts

Today, I wanted to configure an Outlook 2007 rule to process RSS items as they are received. By process I mean I wanted to check for attachments/enclosures, if it had any MP3s attached/enclosed then save them to a folder on my desktop (that way I simply sync my Creative Zen Vision: M with the desktop folder and I have all my podcasts available for my commute).

 I could not seem to get the Outlook rules engine working correctly on RSS feeds, I wanted to run a script (a function I’d written in Outlook VBA) that was executed every time I receive a RSS item.
The ‘Run A Script’ action in the rules wizard will only list subroutines with a signature like this:

Sub Foo(objItem As MailItem)

(Of course the subroutine name doesn’t matter…)

Anyway this doesn’t work for RSS items as their message class is IPM.Post.RSS (making them a PostItem object). So this is a bit of a pain and means I cannot process RSS items using a rule.
In the end I had to use the following code to do it – I just open the folder of the RSS feed and run this (via a custom toolbar button) and it does it all for me.

Public Sub SaveRSSEnclosures() Dim att As Attachment, objList As Object, objItem As Object, iCount As Integer Set objList = Application.ActiveExplorer.CurrentFolder.Items iCount = 0 For Each objItem In objList If (objItem.Attachments.Count > 0) And (objItem.UnRead) Then ' iterate through looking for .mp3's For Each att In objItem.Attachments If LCase(Right(att.FileName, 3)) = "mp3" Then ' save it att.SaveAsFile ("c:Userskenhdesktoppodcasts" & att.FileName) iCount = iCount + 1 End If Next End If Next If iCount > 0 Then MsgBox "Saved " & iCount & " mp3 items" End Sub

A good week

This week (so far) has been good – in terms of completing things, productivity and new products.

First off, Microsoft finally released PowerShell for Vista. No more having to ‘play’ on my old lab machine to get to grips with this stuff. There seem to be a number of people reporting failed installs(due to EFS encryption being disabled), just read the comments of the PowerShell blog announcement.

Next, we’re just coming to the final couple of days of a ‘Supporting Exchange 2007, Office 2007 and Vista SPRINT’ at work (we use a form of SCRUM as our development process) – all is looking good and we have beta sites lined up.

Then, I noticed Eileen’s (the most communicative Microsoft employee on the planet) post about Office 2003 to Office 2007 command references. An interactive demo from Microsoft when you can click the toolbars and menus of an Office 2003 application and it tells you how to find the equivalent command/function in Office 2007. I spent some time finding the 10 or so commands I’d been having difficulty with and increased my productivity.
Here’s her post : http://blogs.technet.com/eileen_brown/archive/2007/01/31/old-to-new-reference-guides.aspx

Then late last night (again at work) we just completed our internal testing before sending our Archive One product for Microsoft Platform testing. We are testing against 5 of the 6 platform tests (we don’t fit into the ‘Managed Code’ test category as we make extensive use of MAPI which basically requires C++ / Unmanaged code)

My New Category Filing System In Outlook 2007

I always try to keep my Inbox at a manageable level (for me that is less than 50 items). Everything that I have dealt with (or I need for reference) I file in a specific reference folder

ASIDE: I know Getting Things Done, GTD, advocates just deleting it but I’m one of those guys that doesn’t like to delete anything – I have no mailbox quota as we dogfood our own Archiving / Mailbox size control application, Archive One (shameless plugging).

Anyway, when the method I used for filing was to assign each email a category (or multiple categories) and then run an Outlook macro to copy it to a folder with the same name as the category. In Outlook 2003 assigning a category was a bit of a pain / lengthy process so I wrote a bunch of macros to automate this from the click of a single toolbar button.

Now I have Office 2007, assigning categories is much simpler, so I ditched the ‘Assign Category XXX’ macros and just wrote ‘FileBasedOnCategory’ macros. I needed one to process just the selected item and another for processing all items in my Inbox.

Now categorizing is a simple right click and select and storing a single toolbar button away…

 

 Here’s the macros I wrote:

Public Const ReferenceFolder = "zz Reference" Public Sub CategorizeThis() ' Assign a category to the selected objects Dim sCurrent As String, obj As Object, objList As Object Set objList = Application.ActiveExplorer.Selection For Each obj In objList StoreObject obj Next Set obj = Nothing Set objList = Nothing End Sub Public Sub CategorizeAll() ' Assign a category to the selected objects Dim sCurrent As String, obj As Object, objList As Object Set objList = Application.ActiveExplorer.CurrentFolder.Items For Each obj In objList StoreObject obj Next Set obj = Nothing Set objList = Nothing End Sub Private Sub StoreObject(ByRef obj As Object) Dim vCat As Variant, aCats() As String, o As Object, sFolder As String, bOK As Boolean bOK = True If obj.Categories <> "" Then aCats = Split(obj.Categories, ",") For Each vCat In aCats() sFolder = ReferenceFolder & "" & Trim(CStr(vCat)) If CreateMAPIFolder(sFolder) Then Set o = obj.Copy o.Move GetMAPIFolder(sFolder) Else MsgBox ("Could not create folder : " & sFolder) bOK = False Exit For End If Next If bOK Then obj.Delete End If End Sub Private Function CreateMAPIFolder(ByVal sFolder As String) As Boolean ' Create a MAPIFolder object of the specified name if none exists Dim objNS As NameSpace, objParent As MAPIFolder, objChild As MAPIFolder Set objNS = Application.GetNamespace("MAPI") Set objParent = objNS.GetDefaultFolder(olFolderInbox) Dim aFolders() As String, vFolder As Variant aFolders = Split(sFolder, "") For Each vFolder In aFolders On Error Resume Next Set objChild = objParent.Folders(Trim(CStr(vFolder))) If Err Then Set objChild = objParent.Folders.Add(Trim(CStr(vFolder))) Err.Clear Set objParent = objChild Next If (InStr(objChild.FolderPath, sFolder) > 0) Then CreateMAPIFolder = True Else CreateMAPIFolder = False End If Set objParent = Nothing Set objChild = Nothing Set objNS = Nothing End Function Private Function GetMAPIFolder(ByVal FolderName As String) As Object ' Returns a MAPIFolder object of the specified name Dim objNS As NameSpace, objParent As MAPIFolder, objChild As MAPIFolder Set objNS = Application.GetNamespace("MAPI") Set objParent = objNS.GetDefaultFolder(olFolderInbox) Dim aFolders() As String, vFolder As Variant aFolders = Split(FolderName, "") For Each vFolder In aFolders Set objChild = objParent.Folders(CStr(vFolder)) Set objParent = objChild Next Set GetMAPIFolder = objChild Set objParent = Nothing Set objChild = Nothing Set objNS = Nothing End Function

purchase term paper

SupportSuite Knowledgebase RSS feed

I logged a feature enhancement to allow the KB article RSS feed to include articles from ALL categories.

This was set as a LOW PRIORIY by Kayako, but is a high priority for me – nothing else for it, I had to fix it myself…..
Here’s how I added the feature to enter 0 as the category id in the RSS feed url to provide articles from ALL categories.

Edit /modules/knowledgebase/functions_clientkb.php

Change Line 167 from :
if ($key == $kbcategoryid)

To :
if (($key == $kbcategoryid) || ($kbcategoryid == 0))

The url for the feed includes the category id for the artciles you want to see. Enter a category id of 0 to return ALL articles :

http://[your_domain]/rss/index.php?_m=knowledgebase&_a=view&kbcategoryid=0

 

Link to the post I entered on the Kayako forums

scholarship essay writing

SupportSuite – KB bug fixed

I found an issue in SupportSuite (3.0.0.32) where if a client (user) did a KB search they would get the subject line and first 255 characters of each result match – some of these matches would be PRIVATE or DRAFT knowledgebase articles.

I guess this is a bug, but based on the responses (timeframe to even review reported issues) to bugs I reported to Kayako recently, I decided to fix it myself…

Here is what I did :

MODIFIED /modules/core/client_search.php
In the section commented as : // ===== SEARCH ALL MODULES ======== CHANGED if ($module->isRegistered(MODULE_KNOWLEDGEBASE)) { $_searchresults = searchKnowledgebase($_POST["searchquery"]); } TO if ($module->isRegistered(MODULE_KNOWLEDGEBASE)) { $_searchresults = searchClientKnowledgebase($_POST["searchquery"]); } also in the else if block directly below : CHANGE } else if ($_POST["searchtype"] == "knowledgebase" && $module->isRegistered(MODULE_KNOWLEDGEBASE)) { $_searchresults = searchKnowledgebase($_POST["searchquery"]); TO } else if ($_POST["searchtype"] == "knowledgebase" && $module->isRegistered(MODULE_KNOWLEDGEBASE)) { $_searchresults = searchClientKnowledgebase($_POST["searchquery"]); So, you've now forced the client search functions to use a new function (called seachClientKnowledgebase)
that we will now define...
  • Open the file /modules/core/functions_clientsearch.php
  • Copy the whole function named searchKnowledgebase and paste another copy into the same file.
  • Now rename the function to searchClientKnowledgebase.
In the newly pasted and renamed function look for the section starting with // ========BUILD THE CATEGORY LIST FOR THIS GROUP ===== ADD // KH get the status of each article and only use the 'published' ones $_finalpublishedarticlelist = array(); $dbCore->query("SELECT * FROM `". TABLE_PREFIX ."kbarticles` WHERE
(line wrapped) kbarticleid IN (". buildIN($_finalkbarticleidlist) .");"); while ($dbCore->nextRecord()) { if ($dbCore->Record["articlestatus"] == "published") { $_finalpublishedarticlelist[] = $dbCore->Record["kbarticleid"]; } }
DIRECTLY AFTER while ($dbCore->nextRecord()) { if ($dbCore->Record["categorytype"] == SWIFTPUBLIC) { $_finalkbarticleidlist[] = $dbCore->Record["kbarticleid"]; } } Then modify the next block of code to read as follows : if (!count($_finalpublishedarticlelist)) { return $_queryresult; }

Alternatively simply make a backup of your existing files :

  • /modules/core/functions_clientsearch.php
  • /modules/core/client_search.php

and replace them with the files in php_mods.zip

Getting Things Done for Outlook

OK, so I’ve been modifying my (personal) organisational processes recently – how I track my tasks / projects etc…

I’ve kind of moved over to Getting Things Done (GTD) by David Allen. It’s quick and easy and gets rid of all the ‘non critical’ crap that you really don’t need to keep in your (short term cache) head – allowing you to focus what’s important.

Anyway, in addition to understanding an organisational process, there is an element of making it work in your own environment (e.g. configuring your laptop / desktop with the tools to allow you to follow the process easily). There are a number of reviews etc of the Getting Things Done Add In for Outlook by Netcentrics (http://gtdsupport.netcentrics.com/home/). It seems like a pretty good application, but being a bit of a miser / skinflint and having a tendancy to play around with coding / scripting, I decided I didn’t want to spend $70 and that I would hack something together myself.

What I came up with is a set of fairly simple Outlook macros, but it covers all the aspects of GTD that I use. The macros cover :-

  • Make Task – This takes an email and generates a new task. The task gets the body of the email copied into it and it also gets a copy of the email embedded into it.
  • Schedule – This takes an email and generates a new appointment. The appointment gets the body of the email copied into it and also gets a copy of the email embedded into it.
  • Delegate Via Task – This takes an email and generates a new task. The task gets the body of the email copied into it and it also gets a copy of the email embedded into it. It also starts the ‘Assign Task to User’ process.
  • Delegate Via Email – This takes an email and generates a new task with the original email subject preceded by ‘FOLLOW UP’. The task gets the body of the email copied into it and it also gets a copy of the email embedded into it and the line ‘Follow up on task sent by email (Date) to XXXXX’ appended. It then also starts the ‘Forward Email’ process. The original email is ‘Stored for Reference’
  • Store For Ref – This Copies the email into a subfolder of the ‘Reference’ folder with the name of the category assigned to the email. If the email is assigned multiple categories then multiple copies are stored (one in each subfolder)

There are also a bunch of other macros that allow a specific category to be assigned to the item. These are ObjectCat_[CategoryName] or TableCat_[CategoryName]. I simply add the ones I use most so they are available from the toolbar.

The reason there are (seemingly) duplicated functions (one starting with ObjectXXXXXX the other being TableXXXXXX) is that we need to provide the features whether we are in ‘tableview’ (and possibly have multiple emails selected) or if we have the email object itself open

Anyway, here is the code :

' Ken Hughes
' 21 March 2006
' Macros to implement 'Getting Things Done'


' Config variables
Const ReferenceFolder = "Reference"
Const TempFileName = "GTD_Temp_Msg.msg"

These are the constants that I use within my system / folder set – you may have to customise these to your own environment. Reference is the top level folder that all my ‘stored for reference’ subfolders are under (e.g. Development, Helpdesk, Personnel etc)

' For the currently open object, display the categories dialog.
' No need for a Table version of this as you can simple highlight the items in the table view, 
'
right click and choose Categories... Public Sub ObjectCategorise() ' Shows the categories dialog for the item. Dim obj As Object Set obj = Application.ActiveInspector.CurrentItem obj.Display obj.ShowCategoriesDialog obj.Save obj.Close 2 Set obj = Nothing End Sub ' Takes each highlighted email in the tableview and creates a task for it.
' Also copies the email body into the task body and attaches the email object into the task body.
Public Sub TableMakeTask() ' Convert an email into a task Dim objEmail As MailItem, objNewTask As TaskItem For Each objEmail In Application.ActiveExplorer.Selection Set objNewTask = CreateTaskFromEmail(objEmail) objEmail.Move GetMAPIFolder(ReferenceFolder) objNewTask.Display Next Set objEmail = Nothing Set objNewTask = Nothing End Sub ' Takes the currently open email object and creates a task for it.
' Also copies the email body into the task body and attaches the email object into the task body.
Public Sub ObjectMakeTask() ' Convert an email into a task Dim objEmail As MailItem, objNewTask As TaskItem Set objEmail = Application.ActiveInspector.CurrentItem Set objNewTask = CreateTaskFromEmail(objEmail) objEmail.Move GetMAPIFolder(ReferenceFolder) objNewTask.Display Set objEmail = Nothing Set objNewTask = Nothing End Sub ' Takes each highlighted email in the tableview and creates an appointment for it. ' Also copies the email body into the appointment body and attaches the email object
' into the appointment body.
Public Sub TableSchedule() ' Convert an email into an appointment Dim objEmail As MailItem, objNewAppt As AppointmentItem For Each objEmail In Application.ActiveExplorer.Selection Set objNewAppt = CreateApptFromEmail(objEmail) objEmail.Move GetMAPIFolder(ReferenceFolder) objNewAppt.Display Next Set objEmail = Nothing Set objAppt = Nothing End Sub ' Takes the currently open emailobject and creates an appointment for it. ' Also copies the email body into the appointment body and attaches the email
' object into the appointment body.
Public Sub ObjectSchedule() ' Convert an email into an appointment Dim objEmail As MailItem, objNewAppt As AppointmentItem Set objEmail = Application.ActiveInspector.CurrentItem Set objNewAppt = CreateApptFromEmail(objEmail) objEmail.Move GetMAPIFolder(ReferenceFolder) objNewAppt.Display Set objEmail = Nothing Set objAppt = Nothing End Sub ' Takes each highlighted email in the tableview and creates an assigned task for it. ' Also copies the email body into the task body and attaches the email object into the task body. Public Sub TableDelegateViaTask() ' Creates a task from an email and lets user assign owner Dim objEmail As MailItem, objNewTask As TaskItem For Each objEmail In Application.ActiveExplorer.Selection Set objNewTask = CreateTaskFromEmail(objEmail) objEmail.Move GetMAPIFolder(ReferenceFolder) objNewTask.Assign objNewTask.Display Next Set objEmail = Nothing Set objNewTask = Nothing End Sub ' Takes the currently open email object and creates an assigned task for it. ' Also copies the email body into the task body and attaches the email object into the task body. Public Sub ObjectDelegateViaTask() ' Creates a task from an email and lets user assign owner Dim objEmail As MailItem, objNewTask As TaskItem Set objEmail = Application.ActiveInspector.CurrentItem Set objNewTask = CreateTaskFromEmail(objEmail) objEmail.Move GetMAPIFolder(ReferenceFolder) objNewTask.Assign objNewTask.Display Set objEmail = Nothing Set objNewTask = Nothing End Sub ' Takes each highlighted email in the tableview and creates a task for it (that you track yourself) ' and also forwards the original email (allowing you to delegate it via email). ' Also copies the email body into the task body and attaches the email object into the task body. Public Sub TableDelegateViaEmail() ' Creates a personal task from an email and forwards the original email Dim objEmail As MailItem, objNewTask As TaskItem For Each objEmail In Application.ActiveExplorer.Selection Set objNewTask = CreateTaskFromEmail(objEmail) objEmail.Move GetMAPIFolder(ReferenceFolder) objNewTask.Subject = "FOLLOW UP: " & objNewTask.Subject objNewTask.Body = " Follow up on task sent by email (" & Date & ") to XXXXX" Set objEmail = objEmail.Forward objEmail.Display objNewTask.Display Next Set objEmail = Nothing Set objNewTask = Nothing End Sub ' Takes each highlighted email in the tableview and creates a task for it (that you track yourself) ' and also forwards the original email (allowing you to delegate it via email). ' Also copies the email body into the task body and attaches the email object into the task body. Public Sub ObjectDelegateViaEmail() ' Creates a personal task from an email and forwards the original email Dim objEmail As MailItem, objNewTask As TaskItem Set objEmail = Application.ActiveInspector.CurrentItem Set objNewTask = CreateTaskFromEmail(objEmail) objEmail.Move GetMAPIFolder(ReferenceFolder) objNewTask.Subject = "FOLLOW UP: " & objNewTask.Subject objNewTask.Body = " Follow up on task sent by email (" & Date & ") to XXXXX" Set objEmail = objEmail.Forward objEmail.Display objNewTask.Display Set objEmail = Nothing Set objNewTask = Nothing End Sub Public Sub TableStoreForReference() ' Stores the email object in the reference folder Dim obj As Object For Each obj In Application.ActiveExplorer.Selection StoreObject obj Next Set obj = Nothing End Sub Public Sub ObjectStoreForReference() ' Stores the email object in the reference folder Dim obj As Object Set obj = Application.ActiveInspector.CurrentItem StoreObject obj Set obj = Nothing End Sub

These following macros are the ‘quick access’ macros I use to assign categories to a email object (so it can be stored in the appropriate place)

Public Sub ObjectCat_Blank()

    ' Assigns the specified category to the object
    ObjectAssignCategory ""

End Sub


Public Sub TableCat_Blank()

    ' Assigns the specified category to the object
    TableAssignCategory ""

End Sub



Public Sub ObjectCat_IT()

    ' Assigns the specified category to the object
    ObjectAssignCategory "IT"

End Sub


Public Sub TableCat_IT()

    ' Assigns the specified category to the object
    TableAssignCategory "IT"

End Sub


Public Sub ObjectCat_Helpdesk()

    ' Assigns the specified category to the object
    ObjectAssignCategory "Helpdesk"

End Sub


Public Sub TableCat_Helpdesk()

    ' Assigns the specified category to the object
    TableAssignCategory "Helpdesk"

End Sub


Public Sub ObjectCat_Development()

    ' Assigns the specified category to the object
    ObjectAssignCategory "Development"

End Sub


Public Sub TableCat_Development()

    ' Assigns the specified category to the object
    TableAssignCategory "Development"

End Sub


Public Sub ObjectCat_Sales()

    ' Assigns the specified category to the object
    ObjectAssignCategory "Sales"

End Sub


Public Sub TableCat_Sales()

    ' Assigns the specified category to the object
    TableAssignCategory "Sales"

End Sub


Public Sub ObjectCat_Partners()

    ' Assigns the specified category to the object
    ObjectAssignCategory "Partners"

End Sub


Public Sub TableCat_Partners()

    ' Assigns the specified category to the object
    TableAssignCategory "Partners"

End Sub


Public Sub ObjectCat_Customers()

    ' Assigns the specified category to the object
    ObjectAssignCategory "Customers"

End Sub


Public Sub TableCat_Customers()

    ' Assigns the specified category to the object
    TableAssignCategory "Customers"

End Sub

Private Sub TableAssignCategory(ByVal sCat As String)

    ' Assign a category to the object
 
    Dim sCurrent As String, obj As Object

    For Each obj In Application.ActiveExplorer.Selection
        sCurrent = obj.Categories
        If sCat = "" Then
            sCurrent = ""
        Else
            If sCurrent <> "" Then
                sCurrent = sCurrent & ", " & sCat
            Else
                sCurrent = sCat
            End If
        End If
        obj.Categories = sCurrent
        obj.Save
    Next

    Set obj = Nothing

End Sub


Private Sub ObjectAssignCategory(ByVal sCat As String)

    ' Assign a category to the object

    Dim sCurrent As String, obj As Object

    Set obj = Application.ActiveInspector.CurrentItem
    sCurrent = obj.Categories
    If sCat = "" Then
        sCurrent = ""
    Else
        If sCurrent <> "" Then
            sCurrent = sCurrent & ", " & sCat
        Else
            sCurrent = sCat
        End If
    End If
    obj.Categories = sCurrent
    obj.Save

    Set obj = Nothing

End Sub

This final macro does the filing of the email objects based on the categories they have been assigned

Public Sub DeferItem(ByRef objEmail As MailItem)

    ' Stores the email object in the reference folder

    Dim objEmail As MailItem, frm As frmDefer, sInterval As String, iInterval As Integer
    Set frm = New frmDefer

    For Each objEmail In Application.ActiveExplorer.Selection

        frm.Show vbModal
        Select Case LCase(frm.Result)

            Case "someday"
                ' move it to the 'someday' folder
                objEmail.Move GetMAPIFolder(SomedayFolder)

            Case "cancel"
                ' do nothing

            Case Else
                ' add a reminder to the email
                objEmail.Move GetMAPIFolder(DeferredFolder)
                objEmail.FlagRequest = "Follow up"
                sInterval = Right(frm.Result, 1)
                iInterval = CInt(Left(frm.Result, 1))
                objEmail.FlagDueBy = DateAdd(sInterval, iInterval, Now())
                objEmail.FlagIcon = olRedFlagIcon
                objEmail.FlagStatus = olFlagMarked

        End Select

    Next


End Sub



Private Functions used as helpers

Private Function CreateTaskFromEmail(ByRef objEmail As MailItem) As TaskItem

    ' Creates a task from an email object.

    Dim objTask As TaskItem
    Set objTask = Application.CreateItem(olTaskItem)
    objTask.Subject = objEmail.Subject
    objTask.Body = "     " & vbCrLf & objEmail.Body
    objEmail.SaveAs (GetTempFolderPath & "" & TempFileName)
    objTask.Attachments.Add GetTempFolderPath & "" & TempFileName, , 1
    Set CreateTaskFromEmail = objTask

End Function

Private Function CreateApptFromEmail(ByRef objEmail As MailItem) As AppointmentItem

    ' Creates an appointment from an email object.

    Dim objAppt As AppointmentItem
    Set objAppt = Application.CreateItem(olAppointmentItem)
    objAppt.Subject = objEmail.Subject
    objAppt.Body = "     " & vbCrLf & objEmail.Body
    objEmail.SaveAs (GetTempFolderPath & "" & TempFileName)
    objAppt.Attachments.Add GetTempFolderPath & "" & TempFileName, , 1
    Set CreateApptFromEmail = objAppt

End Function

Private Function GetMAPIFolder(ByVal FolderName As String) As Object

    ' Returns a MAPIFolder object of the specified name
    Dim objNS As NameSpace, objParent As MAPIFolder, objChild As MAPIFolder
    Set objNS = Application.GetNamespace("MAPI")
    Set objParent = objNS.GetDefaultFolder(olFolderInbox)

    Dim aFolders() As String, vFolder As Variant
    aFolders = Split(FolderName, "")
    For Each vFolder In aFolders
        Set objChild = objParent.Folders(CStr(vFolder))
        Set objParent = objChild
    Next
    Set GetMAPIFolder = objChild
    Set objParent = Nothing
    Set objChild = Nothing
    Set objNS = Nothing

End Function

Private Function GetTempFolderPath() As String

    ' Returns a string value indicating the temporary public folder path
    Dim objFS As FileSystemObject, objTemp As Scripting.Folder

    Set objFS = New FileSystemObject
    Set objTemp = objFS.GetSpecialFolder(2)
    'returns the path found in the TMP environment variable
    GetTempFolderPath = objTemp.Path
    Set objTemp = Nothing
    Set objFS = Nothing

End Function


Private Sub StoreObject(ByRef obj As Object)

    Dim vCat As Variant, aCats() As String, o As Object, sFolder As String, bOK As Boolean

    bOK = True
    If obj.Categories <> "" Then
        aCats = Split(obj.Categories, ",")
        For Each vCat In aCats()
            sFolder = ReferenceFolder & "" & Trim(CStr(vCat))
            If CreateMAPIFolder(sFolder) Then
                Set o = obj.Copy
                o.Move GetMAPIFolder(sFolder)
            Else
                MsgBox ("Could not create folder : " & sFolder)
                bOK = False
                Exit For
            End If
        Next
        If bOK Then obj.Delete
    End If

End Sub

Private Function CreateMAPIFolder(ByVal sFolder As String) As Boolean

    ' Create a MAPIFolder object of the specified name if none exists
    Dim objNS As NameSpace, objParent As MAPIFolder, objChild As MAPIFolder
    Set objNS = Application.GetNamespace("MAPI")
    Set objParent = objNS.GetDefaultFolder(olFolderInbox)

    Dim aFolders() As String, vFolder As Variant
    aFolders = Split(sFolder, "")
    For Each vFolder In aFolders
        On Error Resume Next
        Set objChild = objParent.Folders(Trim(CStr(vFolder)))
        If Err Then Set objChild = objParent.Folders.Add(Trim(CStr(vFolder)))
        Err.Clear
        Set objParent = objChild
    Next
    If (InStr(objChild.FolderPath, sFolder) > 0) Then
        CreateMAPIFolder = True
    Else
        CreateMAPIFolder = False
    End If
    Set objParent = Nothing
    Set objChild = Nothing
    Set objNS = Nothing

End Function

modGTD.bas (12.72 KB)
guidessay.com