R
Ranjit kurian
I have written the macro code in excel, and from excel macro iam able to
DISPLAY the mail based on subject provided, now i need a macro code to copy
the body of displayed mail and paste it to a new excel workbook.
Here is my code....
Private strForwardTo As String
Sub subject_beginswith()
Dim ns As Namespace
Dim Inbox As MAPIFolder
Dim myitem As Outlook.MailItem
Dim Atmt As Attachment
Dim FileName As String
Dim i As Integer
Dim objSearchFolder As Outlook.MAPIFolder
Dim Recipient As Outlook.Recipient
Dim CorrRecip As String
Dim item As Object
Dim Body
Dim mai As MailItem
Set ns = GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(olFolderInbox)
Set objSearchFolder = Inbox
i = 0
If Inbox.Items.Count = 0 Then
MsgBox "Inbox is Empty", vbInformation, "Nothing Found"
End If
For Each item In Inbox.Items
If Format(item.ReceivedTime, "DD/MM/YY") <> Format(Date, "DD/MM/YY") Then
GoTo nextme
If item.Subject Like "Reminder to complete the 2008 Thomson Reuters
Employee*" Then
item.Display
' Workbooks.Add
'ActiveSheet.Paste
SendKeys "(^A)"
Exit Sub
End If
nextme:
Next
End Sub
DISPLAY the mail based on subject provided, now i need a macro code to copy
the body of displayed mail and paste it to a new excel workbook.
Here is my code....
Private strForwardTo As String
Sub subject_beginswith()
Dim ns As Namespace
Dim Inbox As MAPIFolder
Dim myitem As Outlook.MailItem
Dim Atmt As Attachment
Dim FileName As String
Dim i As Integer
Dim objSearchFolder As Outlook.MAPIFolder
Dim Recipient As Outlook.Recipient
Dim CorrRecip As String
Dim item As Object
Dim Body
Dim mai As MailItem
Set ns = GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(olFolderInbox)
Set objSearchFolder = Inbox
i = 0
If Inbox.Items.Count = 0 Then
MsgBox "Inbox is Empty", vbInformation, "Nothing Found"
End If
For Each item In Inbox.Items
If Format(item.ReceivedTime, "DD/MM/YY") <> Format(Date, "DD/MM/YY") Then
GoTo nextme
If item.Subject Like "Reminder to complete the 2008 Thomson Reuters
Employee*" Then
item.Display
' Workbooks.Add
'ActiveSheet.Paste
SendKeys "(^A)"
Exit Sub
End If
nextme:
Next
End Sub