Export Folder Structure + Emails as MSG in Outlook

I came across the following VBA macro. While most people will want to backup their Outlook email via a PST file, some may want to export each message on its own. A single message can be saved by selecting "File - Save As" or by simply dragging the message from Outlook to the desktop, but if you want to do multiple messages while preserving a folder structure it is much more difficult.

In case the article is ever removed I will paste the macro below as well.

Option Explicit Sub SaveAllEmails_ProcessAllSubFolders() Dim i As Long Dim j As Long Dim n As Long Dim StrSubject As String Dim StrName As String Dim StrFile As String Dim StrReceived As String Dim StrSavePath As String Dim StrFolder As String Dim StrFolderPath As String Dim StrSaveFolder As String Dim Prompt As String Dim Title As String Dim iNameSpace As NameSpace Dim myOlApp As Outlook.Application Dim SubFolder As MAPIFolder Dim mItem As MailItem Dim FSO As Object Dim ChosenFolder As Object Dim Folders As New Collection Dim EntryID As New Collection Dim StoreID As New Collection Set FSO = CreateObject("Scripting.FileSystemObject") Set myOlApp = Outlook.Application Set iNameSpace = myOlApp.GetNamespace("MAPI") Set ChosenFolder = iNameSpace.PickFolder If ChosenFolder Is Nothing Then Goto ExitSub: End If Prompt = "Please enter the path to save all the emails to." Title = "Folder Specification" StrSavePath = BrowseForFolder If StrSavePath = "" Then Goto ExitSub: End If If Not Right(StrSavePath, 1) = "\" Then StrSavePath = StrSavePath & "\" End If Call GetFolder(Folders, EntryID, StoreID, ChosenFolder) For i = 1 To Folders.Count StrFolder = StripIllegalChar(Folders(i)) n = InStr(3, StrFolder, "\") + 1 StrFolder = Mid(StrFolder, n, 256) StrFolderPath = StrSavePath & StrFolder & "\" StrSaveFolder = Left(StrFolderPath, Len(StrFolderPath) - 1) & "\" If Not FSO.FolderExists(StrFolderPath) Then FSO.CreateFolder (StrFolderPath) End If Set SubFolder = myOlApp.Session.GetFolderFromID(EntryID(i), StoreID(i)) On Error Resume Next For j = 1 To SubFolder.Items.Count Set mItem = SubFolder.Items(j) StrReceived = ArrangedDate(mItem.ReceivedTime) StrSubject = mItem.Subject StrName = StripIllegalChar(StrSubject) StrFile = StrSaveFolder & StrReceived & "_" & StrName & ".msg" StrFile = Left(StrFile, 256) mItem.SaveAs StrFile, 3 Next j On Error Goto 0 Next i ExitSub: End Sub Function StripIllegalChar(StrInput) Dim RegX As Object Set RegX = CreateObject("vbscript.regexp") RegX.Pattern = "[\" & Chr(34) & "\!\@\#\$\%\^\&\*\(\)\=\+\|\[\]\{\}\`\'\;\:\<\>\?\/\,]" RegX.IgnoreCase = True RegX.Global = True StripIllegalChar = RegX.Replace(StrInput, "") ExitFunction: Set RegX = Nothing End Function Function ArrangedDate(StrDateInput) Dim StrFullDate As String Dim StrFullTime As String Dim StrAMPM As String Dim StrTime As String Dim StrYear As String Dim StrMonthDay As String Dim StrMonth As String Dim StrDay As String Dim StrDate As String Dim StrDateTime As String Dim RegX As Object Set RegX = CreateObject("vbscript.regexp") If Not Left(StrDateInput, 2) = "10" And _ Not Left(StrDateInput, 2) = "11" And _ Not Left(StrDateInput, 2) = "12" Then StrDateInput = "0" & StrDateInput End If StrFullDate = Left(StrDateInput, 10) If Right(StrFullDate, 1) = " " Then StrFullDate = Left(StrDateInput, 9) End If StrFullTime = Replace(StrDateInput, StrFullDate & " ", "") If Len(StrFullTime) = 10 Then StrFullTime = "0" & StrFullTime End If StrAMPM = Right(StrFullTime, 2) StrTime = StrAMPM & "-" & Left(StrFullTime, 8) StrYear = Right(StrFullDate, 4) StrMonthDay = Replace(StrFullDate, "/" & StrYear, "") StrMonth = Left(StrMonthDay, 2) StrDay = Right(StrMonthDay, Len(StrMonthDay) - 3) If Len(StrDay) = 1 Then StrDay = "0" & StrDay End If StrDate = StrYear & "-" & StrMonth & "-" & StrDay StrDateTime = StrDate & "_" & StrTime RegX.Pattern = "[\:\/\ ]" RegX.IgnoreCase = True RegX.Global = True ArrangedDate = RegX.Replace(StrDateTime, "-") ExitFunction: Set RegX = Nothing End Function Sub GetFolder(Folders As Collection, EntryID As Collection, StoreID As Collection, Fld As MAPIFolder) Dim SubFolder As MAPIFolder Folders.Add Fld.FolderPath EntryID.Add Fld.EntryID StoreID.Add Fld.StoreID For Each SubFolder In Fld.Folders GetFolder Folders, EntryID, StoreID, SubFolder Next SubFolder ExitSub: Set SubFolder = Nothing End Sub Function BrowseForFolder(Optional OpenAt As String) As String Dim ShellApp As Object Set ShellApp = CreateObject("Shell.Application"). _ BrowseForFolder(0, "Please choose a folder", 0, OpenAt) On Error Resume Next BrowseForFolder = ShellApp.self.Path On Error Goto 0 Select Case Mid(BrowseForFolder, 2, 1) Case Is = ":" If Left(BrowseForFolder, 1) = ":" Then BrowseForFolder = "" End If Case Is = "\" If Not Left(BrowseForFolder, 1) = "\" Then BrowseForFolder = "" End If Case Else BrowseForFolder = "" End Select ExitFunction: Set ShellApp = Nothing End Function



So I dipped my toe into web development as a favor for a friend and it feels like I've been bitten through no real fault of my own. While the site design isn't necessarily what I would have chosen or gone with its was exactly what he wanted and it seems to work quite well. 

He wanted to put the site live and asked for my opinion on web hosting. Domain.com have been recommended by various online communities I visit for the last 4 or 5 years, they also have a pretty good ethical stance (they seem like saints compared to my regular hosting provider... GoDaddy) anyway despite good promotional offers and Domain.com are crap, hosted applications (phpBB, WordPress etc) are very very slow, and their customer service is no existent. It takes 3-4 days before someone even looks at any tickets you submit, they'll then comment and provide information unrelated to your actual problem, claim your issue has been fixed and then close the ticket so you have no chance of providing feedback OR confirming that the actual issue has been resolved. Its one big JOKE! We'll be waiting for the hosting to come up for renewal and then migrate away.

GoDaddy.com > Domain.com

Video File Conversion

It seems that a lot of video files these days are avi. This is a little annoying as the HP Touchpad doesn’t natively support avi files so I have to convert all my videos to mp4. I have used various converts in the past and had mixed results. Recently I found a great bit of open source software that works very well.
Check out http://handbrake.fr/ for all your video converting needs

Lack of posts

A little while ago I merged a number of my email accounts together, as a result a few of my Google usernames / accounts got folded into one single account. So I ended locking myself out of my blogger account until recently. I went to post something a few months ago and realised I couldn’t login, I didn’t have the time to investigate but as you can see I am now able to login.


You should only open attachments from a trustworthy source

I have dealt with an issue today that took me a little while to figure out.

A user using Outlook 2007 was getting prompted every time they opened an attachment to either save or open it.

"You should only open attachments from a trustworthy source"

On my computer this seemed like a simple fix, unchecked the box that says "Always ask before opening this type of file" However on my end users PC this option was grayed out. Turns out that Outlook needs to be running in Administrator mode. This lead me to my next problem, all their Outlook shortcuts lacked the "Right Click - Run As Administrator" option. So I created a new shortcut for the user on their desktop pointing it to C:\Program Files\Microsoft Office\Office12\Outlook.exe they now have the option to Run Outlook as an administrator.


The Easiest, Fastest Way to Update or Install Software

The Easiest, Fastest Way to Update or Install Software



2011 Year Review

So I’ve now been blogging for just over 3 years (that’s if you discount the 4 months or so that I didn’t blog in last year and if you call what I do blogging and not what it actually is [randomly posting stuff I find useful])
Hooray me!
I have found 2011 to be a tough year and now I think back on it January 2011 seems like a very long time ago. To think around this time last year I helped form Tuesday night football in the form of SevenF (that’s to say I am one of the original 10 who started playing in the current format [5v5 friendly]), I went to China on business and saw what Shanghai has to offer, I visited Baltimore and witnessed my first ever live NFL game! I visited New York City (and loved every moment of it)
While away Maddy sadly had an accident, no one truly knows what happened to her, but she has made a real mess of herself, 2 bouts of surgery later and she seems to getting better. For those interested she’s had femoral head ostectomy, which really is incredible when you read up about it.
Work seems to be weighting in on me recently, XenServer 6.0 upgrade doesn’t seem to have gone all that smoothly and we’re not witnessing some fallout on multiple sites it’s also caused some stability problems with our Exchange environment which has prompted me to investigate moving to a hosted environment, if I can get approval for that then I think I’ll breathe a big sigh of relief when it’s completed.
I also made a difficult decision in December and I have now called it a day on TTFE, having not been happy with the quality of football on offer for at least 12 months (possibly 18?) I have moved on with a few others to form something new, ultimately it’s a better playing surface and so far I’ve found that I’m getting home 30 minutes earlier.  
I have also decided that 2012 will be the year that I change cars, originally I was looking at a Saab 93 TTiD Aero, however with Saab GM filing for insolvency I think we can rule that out (I am more than a little bit gutted, seen as I’ve pined for a Saab for about 3 years now) I am currently looking at a Toyota Avensis Tourer T-Spirit, which seems to come highly spec’d but it does carry a premium price tag, I’m also looking at a Mazda 6 Sport (Hatchback or Estate). We shall see!



I discovered a new backup tool today

EaseUS Todo Backup Free


From my initial testing this looks very good (especially for a free product)... I'm currently waiting to find out what the snag with this product is