Folder view settings by VBA macro

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
#22
probably should add some debug.prints to see if its erroring anywhere... btw, since the destination file is the same for all, you could set that globally (in the app startup) and remove those lines from all of the itemadd macros.

Each item add would be
Private Sub objItems*_ItemAdd(ByVal Item As Object)
On Error Resume Next
Item.Move objDestFolder
End Sub
 

D.Moore

Senior Member
Outlook version
Outlook 2016 64 bit
Email Account
Office 365 Exchange
#23
Thank you for the objDestFolder suggestion, you are absolutely right, i correct it.

i had added debug prints, but no erroring at all. It simply cannot connect to the different shared mailbox, there for, stepping over.

Any idea for a different approach to be try?
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
#24
comment out the on error resume next lines in thisoutlooksession. That should trigger some kind of an error message when it runs. (Sorry I forgot to suggest that earlier.)
 

D.Moore

Senior Member
Outlook version
Outlook 2016 64 bit
Email Account
Office 365 Exchange
#25
Oh, you right, I should think about/realize that. I removed it,

AND

It caught 2 errors:

First time it was (a I already realized is a typo, and corrected it) an object name problem:



because, it should be objDeletedItems, instead of "oDeletedItems". I corrected this. Just a question, how the hell is possible, it was working at all having this mistake ?



Second, and the ONLY error it caught is, exactly with the line whats not working:



and the Debug.Print shows:



May I ask how can I correct this ?



9127.png


[pii removed]
 
Last edited by a moderator:

D.Moore

Senior Member
Outlook version
Outlook 2016 64 bit
Email Account
Office 365 Exchange
#26
(if you can, may I ask to remove the 2nd image, where the email address is visible ? The forum did not allowed that, for some reason. Not because of you, just because these these days, I would not like to have "floating around" on a public forum. BIG thanks in advance)
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
#27
(if you can, may I ask to remove the 2nd image, where the email address is visible ? The forum did not allowed that, for some reason. Not because of you, just because these these days, I would not like to have "floating around" on a public forum. BIG thanks in advance)
I always remove personal information when I see - or at least, I try to remember to do that.
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
#28
Code:
    Set objNS = Application.GetNamespace("MAPI")
    Set objItemsPOLAR = GetFolderPath("test@test6.com\Sent Items").Items
This should not make a difference, but you dont need to set objns. Actually, you should only need to set it once and all of the code will share it.

since you are declaring objSourceFolderPOLAR already, try this. If it still errors on the getfolder path line, then it cant find the path.
Code:
set objSourceFolderPOLAR = GetFolderPath("test@test6.com\Sent Items")
    Set objItemsPOLAR = objSourceFolderPOLAR.Items
 

D.Moore

Senior Member
Outlook version
Outlook 2016 64 bit
Email Account
Office 365 Exchange
#29
Thank you! I had been modified the code as you suggested, but the problem is still the same:
9127.png

I am confused, as the shared mailbox is attached, permissions are owner level, name is correct, what the heck can be bad ?
 

D.Moore

Senior Member
Outlook version
Outlook 2016 64 bit
Email Account
Office 365 Exchange
#30
Hi Diane,

I had decided to solve this problem in a different way as there is no reason to waste your time with something, most probably server level anyway. I will merge the 2 exchange mailbox to one, than it will be a standard shared account, so that way, I will be able to access like the other ones. LOL! Its a solution anyway...

I had started to fix an other 2 problems (related to each other) I suffered a lot in outlook (apologize in advance for being long, but i wanted to be detailed so, you can understand the problems):

1. When I reply to someone, either reply, reply all, or forward, i would like to set the FROM sender based on the email recipient address I am replying on.
- So eg.: if I am replying on an email which were sent to: test1@test.com;moore@test.com, then I going through the recipients, find my address which is: moore@test.com, open the message for reply, reply all, forward and set the From sender to moore@test.com .
- Important to say, that moore@test.com is properly in GAL address book and has full permission to send email on behalf, as I am using this on daily basis, just manually selected at Outlook From field. This is what I would like to automate. Also important to say, that I do NOT want to edit/modify the received email To/From header.

2. When I ReplyAll to someone, I want to remove my own email addresses (moore@test.com, moore@test2.com) from the TO/CC recipient fields of the cretated replyall message, I do NOT want to edit/modify the received email To/From header.

After i had searched through your superior articles and posts, I had found tons of reading and examples, so I was almost sure I can code this. But somehow, I ran into problem again.

Allow me to explain it in detail, for first, the code I had puzzled together (all added to ThisOutlookSession):

Code:
-------------------------------------------------------------------------------------
Dim WithEvents objOpenMail As Outlook.mailItem
Dim WithEvents objAppInspectors As Outlook.Inspectors
Dim WithEvents objMailInspector As Outlook.Inspector

Dim objResponse As mailItem
Private bDiscardEvents As Boolean
Private WithEvents objExplorer As Explorer
Private WithEvents objItem As Outlook.mailItem

Private Sub Application_Startup()

    Set objAppInspectors = Application.Inspectors
    
    Set objExplorer = Application.ActiveExplorer
    bDiscardEvents = False
    
Ens Sub
-------------------------------------------------------------------------------------
Private Sub objAppInspectors_NewInspector(ByVal Inspector As Inspector)

    If Inspector.CurrentItem.Class <> olMail Then

        Exit Sub
    
    End If
    
    Set objOpenMail = Inspector.CurrentItem
    Set objMailInspector = Inspector
    
End Sub
-------------------------------------------------------------------------------------
Private Sub objOpenMail_Open(Cancel As Boolean)

''''''''''' If I put it here, the code below, when only REPLY (and not REPLY ALL) it removes the originally sender from the new created reply email '''''
    
' Dim i As Integer
' Dim delitems As Integer
'
' On Error Resume Next
'
'    delitems = 0
'
'    For i = 1 To objOpenMail.Recipients.Count
'
'        If objOpenMail.Recipients.Item(i).Name = "moore@test.com" Or "moore@test2.com" Then
'
'            delitems = i
'
'        End If
'
'    Next
'
'    If delitems <> 0 Then
'
'        objOpenMail.Recipients.Remove (delitems)
'
'    End If

End Sub
-------------------------------------------------------------------------------------
Private Sub objOpenMail_Close(Cancel As Boolean)
    
 On Error Resume Next
    
    Set objOpenMail = Nothing
    
End Sub
-------------------------------------------------------------------------------------
Private Sub objExplorer_SelectionChange()

 On Error Resume Next
 
    Set objItem = objExplorer.Selection.Item(1)

End Sub
-------------------------------------------------------------------------------------
Private Sub objItem_Reply(ByVal Response As Object, Cancel As Boolean)

 On Error Resume Next

    Cancel = True
    bDiscardEvents = True

    Set objResponse = objItem.Reply

    ReplyForwardReplyAll

End Sub
-------------------------------------------------------------------------------------
Private Sub objItem_Forward(ByVal Response As Object, Cancel As Boolean)
  
 On Error Resume Next
  
    Cancel = True
    bDiscardEvents = True

    Set objResponse = objItem.Forward

    ReplyForwardReplyAll
 
End Sub
-------------------------------------------------------------------------------------
Private Sub objItem_ReplyAll(ByVal Response As Object, Cancel As Boolean)

''''''''''''''' If I put this code here below instead of openMail it removes TO reciepient form oiriginal email '''''''''
' Dim i As Integer
' Dim delitems As Integer
'
' On Error Resume Next
'
'    delitems = 0
'
'    For i = 1 To objItem.Recipients.Count
'
'        If objItem.Recipients.Item(i).Name = "moore@test.com" Or "moore@test2.com" Then
'
'            delitems = i
'
'        End If
'
'    Next
'
'    If delitems <> 0 Then
'
'        objItem.Recipients.Remove (delitems)
'
'    End If

    Cancel = True
    bDiscardEvents = True

    Set objResponse = objItem.ReplyAll

    ReplyForwardReplyAll
 
End Sub
-------------------------------------------------------------------------------------
Private Sub ReplyForwardReplyAll()

  On Error Resume Next
'''''''''''''' How can i read original received message recipient '''''''''''''   
    For i = 1 To objItem.Recipients.Count

        If objItem.Recipients.Item(i).Name = "moore@test.com" Then

            objResponse.SentOnBehalfOfName = "moore@test.com"

        End If

        If objItem.Recipients.Item(i).Name = "moore@test2.com" Then

            objResponse.SentOnBehalfOfName = "moore@test2.com"

        End If

    Next

    objResponse.Display
 
End Sub
-------------------------------------------------------------------------------------
Its sort of work, BUT not in a correct way. There are basically 2 problems I ran into

PROBLEM ONE (removing original recipient):
- This is the code I use to remove my own email address when REPLY ALL:

Code:
 Dim i As Integer
 Dim delitems As Integer

 On Error Resume Next

    delitems = 0

    For i = 1 To objOpenMail.Recipients.Count

        If objOpenMail.Recipients.Item(i).Name = "moore@test.com" Or "moore@test2.com" Then

            delitems = i

        End If

    Next

    If delitems <> 0 Then

        objOpenMail.Recipients.Remove (delitems)

    End If
- The problem is, as you can see commented in my long code above, that i tried to add it into 2 different section. But if
A)
I put it into objOpenMail_Open section, than when I simple reply to a person, it removes the person original sender email address from the newly created/opened Reply message window To field.
OR
B) If I put it into objItem_ReplyAll, than when I replyall to a person, it removes the person email address from the original received email header:

9130.png



PROBLEM TWO (from sender originated from arrived email To recipient):
- After each Reply,replyall and forward, I call ReplyForwardReplyAll() to add one of my email address as From sender at the newly created/opened Reply/ReplyALl/Forward message window From field.

Code:
  On Error Resume Next

    For i = 1 To objItem.Recipients.Count

        If objItem.Recipients.Item(i).Name = "moore@test.com" Then

            objResponse.SentOnBehalfOfName = "moore@test.com"

        End If

        If objItem.Recipients.Item(i).Name = "moore@test2.com" Then

            objResponse.SentOnBehalfOfName = "moore@test2.com"

        End If

    Next

    objResponse.Display
- the problem is, that though I am trying to use objItem.Recipients, which should be the last selected message (so the original received message I m replying on), it isn't, therefore the original TO email in the arrived email header cannot be found, therefore I cannot set to which of my email address the From field should be set, originated from the arrived email to address.
- This was the same according to debug when i tried to add code to either in objOpenMail or in objItem_Reply / Replyall / Forward.

I hope you still with me, and not get mad on me for this such a long message, and I hope I was able to explain, where I stuck.

Could you help me please? Because i couldn't figure it out myself, what am i doing wrong here, though I spent hours on it.

BIG BIG BIG thank you for your patience and help,

Moore
 

D.Moore

Senior Member
Outlook version
Outlook 2016 64 bit
Email Account
Office 365 Exchange
#31
PROBLEM ONE half solution: I was able to do some debug, and I had realized, that Reply, ReplyAll and Forward triggers BEFORE openmail, so I am using a global variable and set it to 0 when Reply and Forward, and 1 when ReplyAll and put the own email address removal code into openmail. At this way, I was able to solve To address removal, and only my own email addresses get removed, though I am not sure, this is the right way to do it. Why I say it is half solution, because:
- it WORKs when either there isnt any email address on CC, so eg.:
To: moore@test.com
- it WORKs when my email address is on CC, so eg.:
To: someone@else.com
CC: moore@test.com
- BUT id does NOT work, when my email address is on TO and someone else on CC, so eg.:
To: moore@test.com
CC: someone@else.com
Very strange...
Since I am checking recipients, which also includes CC, and the remove is out of the For cycle, I have no idea, what can be wrong.

What do you think ?

(With PROBLEM TWO above, i wasnt able to progress any further, I cannot figure it out how to get from the originally arrived email to which email address of mine in was sent to)
 

D.Moore

Senior Member
Outlook version
Outlook 2016 64 bit
Email Account
Office 365 Exchange
#32
PROBLEM TWO solved:

I realized a much better solution, than the one mentioned above. I have to use the To property of objItem to retrieve to which email of mine the message had been sent originally to, and set that one as From sender in the newly opened reply message. I am not sure this is the right approach or not, but it seems to work:

If objItem.To = "Moore" Then

objResponse.SentOnBehalfOfName = "moore@test.com"

End If


PROBLEM ONE actual status (UNSOLVED):

I think, with there are to ways to go here:

A) When I push the Reply or ReplyAll button, leave outlook to add email addresses, and try to remove my own addresses after. This is what i tried above in my earlier messages, and half worked.

B) When I push the Reply or ReplyAll button, oi store all email addresses in To and in CC, empty the newly opened reply message To and CC fields, and re-add all addresses to To and CC, except my ones.

Since I wasnt able to move forward without your help with option A above (my last post) my last post above, I was trying to move forward with option B. But, I failed again. I was basically tried to many things I found docs about, but either couldn't store or re-add To and CC emails from objItem to objResponse OR/AND I wasnt able to resolve the sender display names were added to real addresses. I found lots of materials about it, but couldnt crack to make it work.

So, I stuck here and desperately hope you could help me out.

Many many thank you in advance!
 

D.Moore

Senior Member
Outlook version
Outlook 2016 64 bit
Email Account
Office 365 Exchange
#34
Thank you! I did not found this article, I never imagined to search for this title, LOL.

i was happy to see that the part to set the FROM sender is somewhat the way I made it so, that's awesome.

BUT, this part, does not do, what intended for some reason:

Code:
' remove your address from reply all
Private Sub RemoveRecipients(Item As Outlook.MailItem)
  Dim RemoveThis As VBA.Collection
  Dim Recipients As Outlook.Recipients
  Dim R As Outlook.Recipient
  Dim i&, y&
  Set RemoveThis = New VBA.Collection

  RemoveThis.Add myAddy

  Set Recipients = Item.Recipients
  For i = Recipients.Count To 1 Step -1
    Set R = Recipients.Item(i)

    For y = 1 To RemoveThis.Count
      If LCase$(R.Address) = LCase$(RemoveThis(y)) Then
        Recipients.Remove i
        Exit For
      End If
    Next
  Next
End Sub
No error, just dont remove the emails as it should. I am trying to find it out, why. keep you updated.
 

D.Moore

Senior Member
Outlook version
Outlook 2016 64 bit
Email Account
Office 365 Exchange
#35
Dear Diane,

I am still struggling to make the code work based on the article you provided, BUT I was able to make some progress as I could identified why the code in the article did not worked in my case.

At the moment, it seems at this stage, I am only 1 step/problem away from the solution. Please have a look at the following code part:

Code:
    Set Recipients = objResponse.Recipients
    
    For i = Recipients.Count To 1 Step -1
    
        Set R = Recipients.Item(i)

        If R = "Moore" Then
            
            Recipients.Remove i
      
        End If
    
    Next
With debugging, I can confirm the following:

Recipients.Count = 1

AND

R = "Moore"


My question/problem:

Since the value of R is "Moore", Why it is NOT going into the IF and therefore not trigger the Recipients.Remove ?

I tried it with Like, I also tried it with InStr as well as i tried to use the email address instead of the Display Name. But no luck.

Could you help me please?

Big big thanks,

Moore
 

D.Moore

Senior Member
Outlook version
Outlook 2016 64 bit
Email Account
Office 365 Exchange
#37
Thank you for your kind help, I tried it, and adding some Msgbox to the for cycle for R.address, the following result I got:

/0=S14/ou=Exchange Administrative Group(FYDIBOHF23SPDLT)/cn=2b1789d207b34f67816f092e42702cde-moore@sampledo

So, now it is became obvious that GAL address is making the mass. is there any chance to retrieve the real email address behind GAL address?
 

D.Moore

Senior Member
Outlook version
Outlook 2016 64 bit
Email Account
Office 365 Exchange
#38
While I was searching, I realized, that I could use the "AddressEntry.GetExchangeUser.PrimarySmtpAddress" property, to extract the real email address "masked" by the x500 GAL address. So i was able to make this working code below:

Code:
 Dim SMTPRecipients As Outlook.Recipients
 Dim SMTPaddress As String

    Set SMTPRecipients = objResponse.Recipients 'remove my own email addresses from the newly created reply all message

    For i = SMTPRecipients.Count To 1 Step -1

        SMTPaddress = SMTPRecipients.Item(i).AddressEntry.GetExchangeUser.PrimarySmtpAddress

        If LCase(SMTPaddress) = "more@domain.com" Then

            SMTPRecipients.Remove i
        
        End If
        
    Next
BUT there is a problem:

For some reason, it is also removes other email addresses. Though I always remove the item by "i", for some reason, the last value while the for cycl is running is one of the already removed email address, so, the If statement logically believes it is mine, while deleting a completely different email address.

I am not sure I was able to explain it properly, could you help me please what I am doing wrong here ?

Many many thanks,

Andras
 
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
#39
is every address going to be an exchange address? I dont know if that will cause issues if they aren't , but it could trigger an error. I have a sample somewhere that will check to see if it needs to look up the exchange address.

Otherwise, i dont see anything obvious in the code that would cause problems. add a debug.print SMTPaddress before the if = your address line and see what it prints out.
 

D.Moore

Senior Member
Outlook version
Outlook 2016 64 bit
Email Account
Office 365 Exchange
#40
Brilliant! Again, you were right, I am an idiot. I assumed, that in case it isn't an exchange address, than SMTPaddress will be Null, but instead, it just kept the last value, without having any error. So, I just added SMTPaddress = "" before Next and the problem solved.

BIG BIG BIG Thank you!!!
 

Similar threads

Top