DELETE ME!

[maxwello]

Hi Guys,
Anyone got any ideas on how I can delete my email address from the To field when running the below code? I ahve tried to use the for and if statement which removes the email address but then I cannot get it back into r as it comes bakc with "Run-time error'-2147352567 (80020009) Property is read-only.


Set Original = f.items(eindex)
Set r = f.items(eindex).ReplyAll
'**************** TEST ****************************
Set recips = r.Recipients
For i = recips.Count To 1 Step -1
If LCase(recips.Item(i).Address) = "MYEMAIL@home.com" Then
recips.Remove i
End If
Next
Set r.Recipients = recips
'**************** TEST ****************************
r.Attachments.Add Original
r.SentOnBehalfOfName = "MYEMAIL@home.com"
r.CC = "XXXX@home.com" & ""
r.Subject = "Urgent Chaser 2 - " & f.items(eindex).Subject
r.Body = "Please provide a response to the attached email or the request/action will be archived due to no response."
r.Display ' Change to send

[westconn1]

as you are comparing a lcase string, with a mixed case string, it will never =

[maxwello]

as you are comparing a lcase string, with a mixed case string, it will never =

HHHHMMMMMM, any bright ideas on how best to code it?

I have tried this but it still doesnt work.



If recips.Item(i).Address = "Ecommerce Onboarding EMEA" Then
recips.Remove i

[westconn1]

any bright ideas on how best to code it?make both lcase


but it still doesnt work.does not look like it would match an email address

[maxwello]

I have made both LCase but it still wont match the addresses and I cant understand how I thne get the amended list back so it can be used in the relevant email.

As you can probably tell I am not a natural coder ;)


Case Is = 6 ' Send final chaser for all emails over 6 days
Set Original = f.items(eindex)
Set R = f.items(eindex).ReplyAll
R.Attachments.Add Original
R.SentOnBehalfOfName = "xxx@home.com"
R.CC = "yyy@home.com" & ""
R.Subject = "Urgent Chaser 2 - " & f.items(eindex).Subject
R.Body = "Please provide a response to the attached email or the request/action will be archived due to no response."
'****************************************************************
Set recips = R.Recipients
For i = recips.Count To 1 Step -1
If LCase(recips.Item(i).Address) = LCase("xxx@home.com") Then
recips.Remove i
End If
Next
'****************************************************************
R.Display ' Change to send

[westconn1]

try like

For Each r In objItem.Recipients
If r.Address = "andrew@webuycars.com.au" Then
r.Delete
End If
Nextthis is tested and worked correctly


I cant understand how I thne get the amended list back so it can be used in the relevant email.
as far as i can tell there is no need to do this, the collection is updated as items are removed


R.CC = "yyy@home.com" & ""
i would believe this should be

set newrecip = r.recipients.add("yyy@home.com")
newrecip.AddressEntry.Address = "yyy@home.com"
newrecip.Type = olCC

[maxwello]

Thanks again.
I have gone with the top idea and I ahve played around with it but I cannot get it to work as I keep getting type mismatch.

Do I need to tweak the code or lable one of the variables differently



Dim R As Outlook.MailItem
Dim objItem As MailItem

Case Is = 3 'Send initial chaser for all emails over 3 days
Set Original = f.items(eindex)
Set R = f.items(eindex).ReplyAll
R.Attachments.Add Original
R.SentOnBehalfOfName = xxx@home.com
'r.CC = " " Can be set to cc Sales
R.Subject = "Urgent Chaser 1 - " & f.items(eindex).Subject
R.Body = "Please provide a response to the attached email." '& f.Items(eindex).Body
'****************************************************************
For Each R In objItem.Recipients
If R.Address = "xxx@home.com" Then
R.Delete
End If
Next
'****************************************************************
R.Display ' Change to Send
End Select

[westconn1]

as you do not specify, i assume it is because your " " are in the wrong places, though you had it correct previously

[maxwello]

Apologies the error happens when it passes this section of the code.


For Each R In objItem.Recipients

[westconn1]

as you are using r as a mailitem in other parts of the code, you should create some other variable for recipient, my snippet had objitem as the mail item and r as recipient

[maxwello]

as you are using r as a mailitem in other parts of the code, you should create some other variable for recipient, my snippet had objitem as the mail item and r as recipient

I have changed r to t and set as "Dim t AS Recipients" with objitem as "Dim objItem As MailItem" but when it hits the line
For Each t In objItem.Recipients I get a "Object variable or With black variable not set." I have tried setting the objitem to
Set objitem = f.items(eindex)? but I then get the Run-time error '13': Type Mismatch again when it hits the line
For Each t In objItem.Recipients.

[westconn1]

try
for each t in r.recipients
as r is already your reply mailitem that you want to work with
i do not know why you should get a type mismatch error at that point, even if there are no recipients, it should not give that errror

[maxwello]

Thanks you all for the assistance, below is the final code that will send out auto chasers for emails with a specific category and work out the number of working days and delete specific emails from the reply before sending.


Sub ApplicationReminder()
Dim m As Outlook.MailItem
Dim R As Outlook.MailItem
Dim eindex As Integer
Dim Original As Object
Dim OutApp As New Outlook.Application
Dim oMAPI As Outlook.NameSpace
Dim oParentFolder As Outlook.MAPIFolder
Dim oFolder As Outlook.folder
Dim workdays As Long
Dim recips As Outlook.Recipients
Dim i As Long
Dim t As Outlook.Recipient
Dim Endate As Variant
Dim test As String
Dim objItem As MailItem
Dim reps As String
Dim RemoveThis As VBA.Collection
Dim Recipients As Outlook.Recipients
Dim v As Long
Dim y As Long
Set RemoveThis = New VBA.Collection
Dim StartDate As Date

'*******************Set Email Folder****************************************************
'Set email folders
Set OutApp = New Outlook.Application
Set oMAPI = OutApp.GetNamespace("MAPI")
Set oParentFolder = oMAPI.Folders("Mailbox - ") 'Set mail box where the emails are
Set f = oParentFolder.Folders("Inbox")
'********************Works through emials with specific category****************************************************
For eindex = f.items.Count To 1 Step -1
If InStr(f.items(eindex).Categories, "Pending Response - Macro") > 0 Then
i = Now - f.items(eindex).SentOn
'**************************Works out the number of work days*******************
EndDate = Date
StartDate = f.items(eindex).SentOn
StartDate = Format(StartDate, "dd/mm/yyyy")
For i = StartDate To EndDate
EndDate = StartDate + i
If Weekday(EndDate) = 6 Then i = i + 2
days = days + 1
Next i
'*************************Select Statements for day age buckets******************************************************
Set objItem = f.items(eindex)
Select Case days
Case Is > 10 'Move Emails over 10 days to No Reply Recieved
f.items(eindex).Categories = Replace(f.items(eindex).Categories, "Pending Response", "No Response Received")
f.items(eindex).Save
Case Is = 6 ' Send final chaser for all emails over 6 days
Set Original = f.items(eindex)
Set R = f.items(eindex).ReplyAll
R.Attachments.Add Original
R.SentOnBehalfOfName = "Set email address"
R.CC = "Set email address" & ""
R.Subject = "Urgent Chaser 2 - " & f.items(eindex).Subject
R.Body = "Please provide a response to the attached email or the request/action will be archived due to no response."
'************Deletes the eCommerce Onboarding Email**************
RemoveThis.Add "/Set email address"
Set Recipients = R.Recipients
For v = Recipients.Count To 1 Step -1
Set t = Recipients.Item(v)
For y = 1 To RemoveThis.Count
If LCase$(t.Address) = LCase$(RemoveThis(y)) Then
Recipients.Remove v
Exit For
End If
Next
Next
'****************************************************************
R.Display ' Change to send
Case Is = 3 'Send initial chaser for all emails over 3 days
Set Original = f.items(eindex)
Set R = f.items(eindex).ReplyAll
R.Attachments.Add Original
R.SentOnBehalfOfName = "Set email address"
'r.CC = " " Can be set to cc Sales
R.Subject = "Urgent Chaser 1 - " & f.items(eindex).Subject
R.Body = "Please provide a response to the attached email." '& f.Items(eindex).Body
'************Deletes the eCommerce Onboarding Email**************
RemoveThis.Add "Set email address"
Set Recipients = R.Recipients
For v = Recipients.Count To 1 Step -1
Set t = Recipients.Item(v)
For y = 1 To RemoveThis.Count
If LCase$(t.Address) = LCase$(RemoveThis(y)) Then
Recipients.Remove v
Exit For
End If
Next
Next
'****************************************************************
R.Display ' Change to Send
End Select
End If
days = 0
Next
End Sub