bsharath
asked on
Outlook emails that are sent. Need to get data from subject and to whome i emailed.
Hi,
Outlook emails that are sent. Need to get data from subject and to whome i emailed.
I have emails send to 1000's of users. With the below line in the body of the emails.
"This Application is not allowed in the development environment"
i want a macro that i select a folder and run. When run has to check for this body line and get the To user i emailed and the date and the subject data to an excel.
It should be only new emails and not reply or forwarded emails.
regards
sharath
Outlook emails that are sent. Need to get data from subject and to whome i emailed.
I have emails send to 1000's of users. With the below line in the body of the emails.
"This Application is not allowed in the development environment"
i want a macro that i select a folder and run. When run has to check for this body line and get the To user i emailed and the date and the subject data to an excel.
It should be only new emails and not reply or forwarded emails.
regards
sharath
ASKER
Yes thats fine Chris
RE:\FW: are the subject starts
RE:\FW: are the subject starts
How about:
Note filename appears twice.
Chris
Note filename appears twice.
Chris
Sub Q_26483653()
Dim mai As Object
Dim xlApp As Object
Dim wb As Object
Dim rw As Long
Const xlup As Integer = -4162
Set xlApp = CreateObject("excel.application")
On Error Resume Next
Set wb = xlApp.workbooks.Open("C:\deleteme\Q_26483653.xlsx")
On Error GoTo 0
If wb Is Nothing Then
Set wb = xlApp.workbooks.Add
wb.sheets(1).Range("A1") = "Mail Sent Date"
wb.sheets(1).Range("B1") = "Mail Sent To"
wb.sheets(1).Range("C1") = "MAil Subject"
wb.saveas "C:\deleteme\Q_26483653.xlsx"
End If
For Each mai In Application.Session.PickFolder.items
If mai.Class = olMail Then
If InStr(mai.Subject, "FW:") <> 1 And InStr(mai.Subject, "RE:") <> 1 Then
If InStr(LCase(mai.body), LCase("This Application is not allowed in the development environment")) > 0 Then
rw = wb.sheets(1).Range("A" & wb.sheets(1).Rows.count).End(xlup).Row + 1
wb.sheets(1).Range("A" & rw) = mai.senton
wb.sheets(1).Range("B" & rw) = mai.Recipients(1)
wb.sheets(1).Range("C" & rw) = mai.Subject
End If
End If
End If
Next
wb.Close True
xlApp.Quit
End Sub
ASKER
Works fine Chris
but i get to people who are in CC as well.
I want emails sent to and people in TO only
but i get to people who are in CC as well.
I want emails sent to and people in TO only
The following should only pick names from the to field ... if that is the requirement
Chris
Chris
Sub Q_26483653()
Dim mai As Object
Dim xlApp As Object
Dim wb As Object
Dim rw As Long
Dim recip As Recipient
Const xlup As Integer = -4162
Set xlApp = CreateObject("excel.application")
On Error Resume Next
Set wb = xlApp.workbooks.Open("C:\deleteme\Q_26483653.xlsx")
On Error GoTo 0
If wb Is Nothing Then
Set wb = xlApp.workbooks.Add
wb.sheets(1).Range("A1") = "Mail Sent Date"
wb.sheets(1).Range("B1") = "Mail Sent To"
wb.sheets(1).Range("C1") = "MAil Subject"
wb.saveas "C:\deleteme\Q_26483653.xlsx"
End If
For Each mai In Application.Session.PickFolder.items
If mai.To <> "" Then
If mai.Class = olMail Then
If InStr(mai.Subject, "FW:") <> 1 And InStr(mai.Subject, "RE:") <> 1 Then
If InStr(LCase(mai.body), LCase("This Application is not allowed in the development environment")) > 0 Then
rw = wb.sheets(1).Range("A" & wb.sheets(1).Rows.count).End(xlup).Row + 1
wb.sheets(1).Range("A" & rw) = mai.senton
For Each recip In mai.Recipients
If recip.Type = olTo Then
wb.sheets(1).Range("B" & rw) = recip
Exit For
End If
Next
wb.sheets(1).Range("C" & rw) = mai.Subject
End If
End If
End If
End If
Next
wb.Close True
xlApp.Quit
End Sub
ASKER
I get object does not support.
When debug goes here
If mai.To <> "" Then
When debug goes here
If mai.To <> "" Then
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Thanks a lot Chris works perfect
:-)
:-)
A second best method could simply check for the RE: or FWD: prefix in the subject line ... if that's what you see (and leave intact).
If this latter method would be acceptable can you confirm exactly which prefixes you have for forward/reply?
Chris