Outlook PST to MSG Export

Exports a PST file to individual MSG files using Redemption. It doesn not (currently) recreate the outlook folder structure into directories, just dumps msg files to a single folder.

Tested, working sample but would suggest some tweaking / reading up on your own.

Important note: This does NOT create a mapi profile. You must create a profile prior to running the script.

Control Panel -> Mail
Show Profiles 
Add
Profile name MUST match MAPI profile= in the script
Click OK
Select "View / Change Existing" -> NEXT
Click Finish
Warning blahblah� Click OK
Click OK to exit
Never have to do anything else with this profile� just create it blank�!!

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; PST to MSG
; Extracts all messages in a PST to individual MSG files
; Does NOT re-create folder structure from the PST (currently)
; Writes files in the format <SUBJECT - SUBMIT TIME (YYYY-MM-DD-HH-MM-SS)
;
; You must install / register the Redemption.dll from
; http://www.dimastr.com/redemption/
; see his licensing information....
;
; -= Crypt =- 2006
; Special thanks to jalverson for the fine examples and help
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;Fixed variables here. Comment in and use for testing only
;param1 = "D:\PstExport2"
;param2 = "D:\PSTBackup\SOMEpstFile.pst"
;param0=2

If Param0 != 2 Then Goto Help
MAPIProfile="RDOExport" ; <- This must match an existing MAPI profile. Needs to exist but can be unconfigured.
If !DirExist(Param1) Then DirMake(Param1)
If !FileExist(Param2) Then Goto PSTErr


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
#DefineFunction GetSubFolders(folder)
      subFolders = folder.Folders
      hEnum = ObjectCollectionOpen(subFolders)
      While @TRUE
        objFolder = ObjectCollectionNext(hEnum)
        If objFolder == 0 Then Break
         GetSubFolders(objFolder)
        ObjectClose(objFolder)
      EndWhile
      ObjectCollectionClose(hEnum)
      Return
#EndFunction

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
#DefineFunction CheckUnique(File)
      ; Hmm... still better make sure it's unique..
      ; This will handle proper sort of the first 99
      ; lets just blop on some zeros for now
      X=0
      :loop
      x=x+1
      If FileExist(File)
         FileRaw=ItemRemove(-1, File, ".")
         If StrLen(x) < 2 Then x=StrFixLeft(x, 0, 2)
         FileNew=StrCat(FileRaw,"_",x,".msg")
         If FileExist(FileNew) Then Goto loop
      Else
         Filenew=File
      EndIf
      Return(FileNew)
#EndFunction

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

objSession=CreateObject("Redemption.RDOSession")
objSession.logon("RDOExport") ;Select an existing, VALID outlook profile!
Store = objSession.Stores.AddPSTStore(Param2, 1, "Attached PST")
Folders=Store.IPMRootFolder.Folders
hEnum = ObjectCollectionOpen(Folders)

While @TRUE
  objFolder = ObjectCollectionNext(hEnum)
  If objFolder == 0 Then Break
;   Message("",objFolder.Name) ; name of current folder
   GetSubFolders(objFolder)
      ;READ MAIL Message Info
      objcount=objFolder.Items
      mycount=objcount.Count ;checks number of messages
      For xx = 1 To mycount
        objitem=objFolder.Items(xx)

         ;There are many other properties on a message but these are all I need :)
         ;For more see http://www.dimastr.com/redemption/rdo/RDOMail.htm
         subject      = objitem.Subject
         submitTime   = objitem.CreationTime

         ;Better clean this up a bit so we have a valid filename...
         subject=StrReplace(subject,":","")
         subject=StrClean(subject, 'abcdefghijklmonpqrstuvwxyz0123456789~!@#$^&()_-,.=+{}[]', " ", @FALSE,2)
         submitTime=StrReplace(submitTime,":",".")
         FileName=StrCat(subject," (",submitTime,")") ;<- Append msg Submit time to the filename
         FileName=StrCat(param1,"\",FileName,".msg")

         FileName=CheckUnique(FileName)
;         message("Proposed File Name",FileName)
         ; Several options in RDO for output type of the file... noted below.
         ; If you change this, you should change the extension to the appropriate one (not .msg)
         ;olMSG (3)
         ;olTemplate (2)
         ;olTxt (0)
         ;olVCard (6)
         ;olRFC822 (1024)
         ;olTNEF (1025)
         ;olHTML (5)
         Type=3
         objitem.SaveAs(FileName, 3)

      Next
  ObjectClose(objFolder)
EndWhile

ObjectCollectionClose(hEnum)
ObjectClose(objSession)
Store.Remove

Exit

:Help
m1="Usage:"
m2="PSTtoMSG <output Directory> <PST Name>"
m3="Note: Don't use a trailing backslash on the Output Dir Name!"
msg=StrCat(m1,@CRLF,m2,@CRLF,m3,@CRLF)
Message("Invalid command line",msg)
Exit


:PSTerr
Message("Invalid PST","PST file not found. Maybe try the full path?")
Exit

Article ID:   W17130

File Created: 2007:07:03:14:28:26

Last Updated: 2007:07:03:14:28:26

Database Search

TechHome

Outlook PST to MSG Export