Wednesday, January 13, 2010

Script to Open your Outlook and save unread mails into your desired Folder

'Creating a Folder to Save Mails

dim fso,myolApp,myNameSpace,Inbox,Btn,Inbox_Items

dim wso

set wso=createobject("Wscript.shell")

set fso=createobject("Scripting.filesystemobject")

Set myOlApp = CreateObject("Outlook.Application")

Set myNameSpace = myOlApp.Application.GetNameSpace("MAPI")

Set Inbox=myNameSpace.GetDefaultFolder(6)

Inbox.Display

Set Btn = myolApp.ActiveExplorer.CommandBars.FindControl(1, 7095)

Btn.Execute

Set Inbox_Items = Inbox.Items

wso.popup "Number of items in your Inbox: "&Inbox_Items.Count,3,"Inbox Count"

'no_of_Mails=inputbox("Enter NO.of Mails you wanna read","Number of Mails","1")

UnReadMails=0

Set drv = fso.GetDrive("F:\")

fld_name=inputbox("Enter a Folder name you need to Save Your Mails","Mails Storage Folder","Mails")


For Each Mail in Inbox_Items 'counter = Inbox_Items.Count to Inbox_Items.Count - no_of_Mails Step -1


If Mail.UnRead=0 Then 'Inbox_Items(counter).UnRead Then


'Wso.Popup "No UnRead Mails",2,"Mails Status"

'Exit For

Else

Wso.popup "Subject of the "&Counter&" th Mail in your Inbox is: "&Mail.Subject,3,"Mail Subject"

Subject=Mail.Subject

Body=Mail.Body

Wso.popup "Body of the Mail: "&Vbnewline&Body,3,"Mail's Body Saving in a"&fld_name

Call Storage(Subject,Body)

UnReadMails=UnReadMails+1

Dim del

del=Msgbox("Do You Wanna Delete a Mail",3,"Wanna Delete?")

'msgbox del

if (del=6) Then

Mail.Delete

'Msgbox "Passed"

End if

End If

Next

wso.popup "Number of UnRead Mails Are: "&UnReadMails,3,"UnRead Mails Count"

Function Storage(Subject,Body)

dim drv,fldr,fil,fld

fldr="F:\"&fld_name

if (fso.folderexists(fldr)) Then

wso.popup "Folder already exists" &Vbnewline& "So, Files will store here" &Vbnewline& fldr,2,"Files Storage Location"

file_name=Subject

if (fso.fileexists("F:\"&fld_name&"\"&file_name&".txt")) Then

msgbox "File exists"

res=msgbox ("File is already exists with this name: Do You wanna replace",3,"Replace")

if (res=6) Then

set fil=fso.createtextfile(fldr&"\"&Subject&".txt",True)

fil.write Body

fil.close

End If

Else

set fil=fso.createtextfile(fldr&"\"&Subject&".txt",False)

fil.write Body

fil.close

End if
else

'Creating a Folder to Save Mails

set fld=fso.createfolder("F:\"&fld_name)

End if

set drv=nothing

set fil=nothing

End Function

set fso=nothing
set myolApp=nothing
set myNameSpace=nothing
set myFolder=nothing
Set myOLBarPane=nothing
Set Inbox_Items=nothing


Thanks & Regards
Baba Fakruddin.D
baba.fakru@gmail.com

No comments:

There was an error in this gadget