Capture password from email in outlook using QTP


Consider the message by auto sending "Password service" is as below 

Hi User, 

Please find the credentials below. 

User Name is: name597406 
New password is: KI7UJ6$x^3DIwul 

Note: Please change your password as soon as you login into your application 

Thanks & Regards, 
Admin 

Check the "From" field and note the Display name of the sender and let it be "Password Service" 

The code is as below
Dim olFolderInbox, iTotalMails, sSubject
olFolderInbox = 6 : sSubject = ""
 
Set objOutlook = CreateObject("Outlook.Application")
Set objNamespace = objOutlook.GetNamespace("MAPI")
 
'Create reference to Inbox Folder
Set oInbox = objNamespace.GetDefaultFolder(olFolderInbox)
 
'Find all items in the Inbox Folder
Set oAllMails = oInbox.Items
iTotalMails = oAllMails.Count
 
'Loop through the mail items
For i=1 to iTotalMails
  'Check if the mail is UnRead or not
    If oAllMails(i).UnRead = True Then
'        msgbox oAllMails(i).sendername
        If oAllMails(i).sendername="Password Service" then
            res=split(oAllMails(i).Body,"password is: ")
            res1=split(res(1),"Note:")
            msgbox res1(0)
            Exit for
        end if
    
    End If
Next