Man wanted to work in dynamite factory. Must be willing to travel.

Can you believe this : this guy has travelled to 5204 cities in 231. I feel like a rookie, compared to this. But then again, I like a challenge.

Growing fat

I am back in Belgium for almost 2 weeks now and my weight keeps on climbing : I came back a skeleton, only weighing 73,6 kilos. Tonight, after the seventh day in a row where I had at least 5 meals that day and kept on eating snacks and candy for the biggest part of the day (and let us not forget the drinks), my total weight has reached 81,7 kilos.

If debugging is the process of removing bugs, then programming must be the process of putting them in.

Before I left on my trip through South America, I decided to clean up all my mailboxes (I never delete a mail) and organize all mails in different PSTs, one for every year. So, I decided to use the import and archiving function of Outlook.

Step 1 : import all mails from a PST to a bulk PST
Step 2 : archive all mails older than a certain date (eg 2005) to a dedicated PST
Step 3 : goto step 1

After an hour or so, I had 10 PST files, each containing all mails sent and received that year. I thought. Outlook had messed up bigtime, it worked for most, but there were still mails from 1999 in the PST of 2004 and vice versa. NOT GOOD. Because I was leaving on my trip, I forget about it, until today and needed a mail I sent in September 2006 and did not find it, because it was in a wrong PST file. Crap. Crap. Triple crap. So, I surfed the web a bit, found myself a program called MessageSave, which made it possible to copy the Outlook folder structure to a filesystem and then you can sort them out quite fast (find will do the job perfectly) and then recreate the PST files. Too bad, the program was expensive.

So, I decided to write it myself. After surfing some VBS sites for half an hour (I hate VB, but hey it was fast, included in Windows and up to the task, but I hadn't used it for 10 years) and writing code for another half hour, the program was finished and worked splendid. Now, it is dumping all PSTs to the filesystem, reoganize them and recreate PST files.

If you would ever need the code, here it is :

' ******************************************************
' Sync_outlook_filesystem.vbs
' Rez Kiyn
' ******************************************************

On Error Resume Next
Dim myNameSpace
Dim ofChosenFolder
Dim myOlApp
Dim myItem
Dim objItem
Dim myFolder
Dim strSubject
Dim strName
Dim strFile
Dim strReceived
Dim strSavePath
Dim strSubFolder
Dim objFileSystem
Dim objOutputFile
Dim strOutputFile

strOutputFile = "./" & Split(WScript.ScriptName, ".")(0) & ".log"

'********************************************************************************************************************
' Initialisation
'********************************************************************************************************************
Set objFileSystem = CreateObject("Scripting.fileSystemObject")
Set objOutputFile = objFileSystem.CreateTextFile(strOutputFile, TRUE)
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set myOlApp = CreateObject("Outlook.Application")
Set myNameSpace = myOlApp.GetNamespace("MAPI")

WriteLog("Initialising synchronisation")

'********************************************************************************************************************
' Runtime parameters
'********************************************************************************************************************
WriteLog("Querying for runtime parameters")

Set ofChosenFolder = myNameSpace.PickFolder
strSavePath = InputBox("Please enter the path to save to", "Save Emails To:", "d:\Data\")

If not right(strSavePath,1) = "\" then
strSavePath = strSavePath & "\"
wscript.echo "You forgot a backslash at the end of your path." & vbcrlf & "But don't worry, I added one for you."
End If

strSaveFolder = Left(strSavePath, Len(strSavePath)-1)

WriteLog("Fetch mails from " & ofChosenFolder )
WriteLog("Saving mails to " & strSavePath )

'********************************************************************************************************************
' Start synchronisation
'********************************************************************************************************************
WriteLog("Starting synchronisation")

syncFolder strSavePath & StripIllegalChar(ofChosenFolder.Name), ofChosenFolder

'********************************************************************************************************************
' End synchronisation
'********************************************************************************************************************
MsgBox "Finished syncing", VBYesNo
WriteLog("Finished Syncing")
objOutputFile.Close

Set objFileSystem = Nothing

'********************************************************************************************************************
' Function to write log line to logfile
'********************************************************************************************************************
Function WriteLog(logLine)
objOutputFile.WriteLine(Date() & " " & Time() & " " & logLine)

End Function

'********************************************************************************************************************
' Function to sync a folder in outlook with the folder on the file system
'********************************************************************************************************************
Function syncFolder(strFSPath, myFolder)
Writelog("Syncing folder '" & myFolder & "' to path '" & strFSPath & "'")

If not right(strFSPath,1) = "\" then
strFSPath = strFSPath & "\"
End if

CreateDirectory strFSPath

Syncitems strFSPath , myFolder

j = 1

For each Folder in myFolder.Folders
set mySubFolder = myFolder.Folders(j)

SyncFolder strFSPath & StripIllegalChar(mySubFolder.Name), mySubFolder

j = j + 1
next

' syncItems strFSPath, myFolder
End Function

'********************************************************************************************************************
' Function to sync a directory contents in outlook with the contents on the file system
'********************************************************************************************************************
Function syncItems(strFSPath, myFolder)
i = 1

For each Item in myFolder.Items
Set myItem = myFolder.Items(i)

WriteLog("Found item '" & myItem & "' in folder '" & myFolder & "'")

strReceived = ArrangedDate(myitem.ReceivedTime)
strSender = StripIllegalChar(myItem.SenderName)
strSubject = myItem.Subject
strName = StripIllegalChar(strSubject)
strFile = strFSPath & strReceived & "_" & strSender & "_" & strName & ".msg"

If Not Len(strfile) > 256 then
myItem.SaveAs strfile, 3
WriteLog("Saving item : " & myItem & " " & " in folder " & myFolder & " to " & strFile)
Else
WriteLog("Path and filename too long for " & strFile)
End If

i = i + 1
next
End Function


'********************************************************************************************************************
' Function to create a directory
'********************************************************************************************************************
Function CreateDirectory(strDirectory)

On Error Resume Next
If Not objFSO.FolderExists(strDirectory) then
objFSO.CreateFolder(strDirectory)

If Err Then
WriteLog("Error in CreateDirectory(" & strDirectory & ")")
End if

WriteLog("Creating directory : " & strDirectory)
Else
WriteLog("Not creating directory : " & strDirectory)
End if

End Function

'********************************************************************************************************************
'Simple function that removes illegal file system characters.
'********************************************************************************************************************
Function StripIllegalChar(strInput)

Set RegX = New RegExp

RegX.pattern = "[\" & chr(34) & "\!\@\#\$\%\^\&\*\(\)\=\+\|\[\]\{\}\`\'\;\:\<\>\?\/\,]"
RegX.IgnoreCase = True
RegX.Global = True

StripIllegalChar = RegX.Replace(strInput, "")
Set RegX = nothing

End Function

'********************************************************************************************************************
'This function re-arranges the date data in order for it to display in chronilogical order in a
'sorted list in the file system. It also removes illegal file system characters and replaces them with dashes.
'Example:
'Input: 2/26/2004 7:07:33 AM
'Output: 2004-02-26_AM-07-07-33
'********************************************************************************************************************
Function ArrangedDate(strDateInput)

Dim strDateTime
Dim RegX
Dim sDate

sDate = CDate(strDateInput)
strDateTime = Year(sDate) & "-" & Month(sDate) & "-" & Day(sDate) & "_" & Hour(sDate) & "-" & Minute(sDate) & "-" & Second(sDate)

Set RegX = New RegExp

RegX.pattern = "[\:\/\ ]"
RegX.IgnoreCase = True
RegX.Global = True

ArrangedDate = RegX.Replace(strDateTime, "-")

Set RegX = nothing

End Function

A short description on everything

It does not get any better than this : We all know the diameter of the earth, how life emerged from the primal soup or Einstein's relatvity theorem (As a geek, I except you to), but no one really knows how we got to this knowledge, how many lifes and money were spent to discover this information, how many people contributed small pieces to the big puzzle called our origin. For example : Did you know Dalton (the guy who discovered Daltonism) was a big contributor to determine the mass of the Earth or Einstein's theorem was used to determine the age of the universe. Well, I you don't and want to know : here is the perfect book for you : scientific and funny. You will love it

And his closing conclusion is one of the most modest ever.