Export Outlook mails to personal data file

'Defualt Mail Folders
Const olFolderDeletedItems = 3
Const olFolderOutbox = 4
Const olFolderSentMail = 5
Const olFolderInbox = 6
Const olFolderCalendar = 9
Const olFolderContacts = 10
Const olFolderJournal = 11
Const olFolderNotes = 12
Const olFolderTasks = 13
Const olFolderDrafts = 16
Const olPublicFoldersAllPublicFolders = 18
Const olFolderJunk = 23
 
strProcessKill = "'OUTLOOK.EXE'"
strComputer = "."
 
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colProcess = objWMIService.ExecQuery ("Select * from Win32_Process Where Name = " & strProcessKill )
 
'Getting the username of the login user
Set objNetwork = Wscript.CreateObject("Wscript.Network")
user = objNetwork.UserName 
 
Set ObjOutlook = CreateObject("Outlook.Application")
 
'Open the Inbox using the GetDefaultFolder method
Set objFolder = ObjOutlook.GetNameSpace("MAPI").GetDefaultFolder(olFolderSentMail)
Set myNameSpace = ObjOutlook.GetNameSpace("MAPI")
	myNameSpace.AddStoreEx "c:\Temp\archive_Sent_Items_" & user & ".pst", 2  'Creating a file in Temp folder with username include
	Set myFolder = myNameSpace.Folders.Getlast()  
    Set myArch = myFolder.Folders.Add("Backup")
 
'Moving the mails from send items which were created in 2007
On Error Resume Next 
For intCounter = objFolder.Items.Count To 1 Step -1
    If cint(mid(cstr(objFolder.Items(intCounter).ReceivedTime),7,4)) = 2007 And cint(objFolder.Items(intCounter).FlagStatus) = 0 Then 
		Set myCopiedItem = objFolder.Items(intCounter).Copy
		myCopiedItem.Move myArch
		objFolder.Items(intCounter).delete
    End If 
Next
myNameSpace.RemoveStore myFolder 'disconnect the new create store after we finish
 
'Killing the process in order to be able to move the file
Set myNameSpace = Nothing
Set oInbox = Nothing
Set ObjOutlook = Nothing
'Stop the Outlook process
For Each objProcess in colProcess
	objProcess.Terminate()
Next
 
MsgBox("Work complete")