Folder view settings by VBA macro

D.Moore

Senior Member
Outlook version
Outlook 2016 64 bit
Email Account
Office 365 Exchange
#1
Hi!

May I ask your kind help with a problem I am struggling with:

I have couple hunders of mail fodlers in outlook, and I would like to create a VBA code, which:

0. Manually executed/run.

1. Pops up a Folder Pickup dialog, somethign like this:

Sub PickFolder()
Dim xNameSpace As NameSpace
Dim xPickFolder As Folder
Dim xExplorer As Explorer
On Error Resume Next
Set xNameSpace = Outlook.Application.Session
Set xPickFolder = xNameSpace.PickFolder
If TypeName(xPickFolder) = "Nothing" Then Exit Sub
Set xExplorer = Outlook.Application.ActiveExplorer
xExplorer.Close
Set xPickFolder = Nothing
Set xNameSpace = Nothing
End Sub


- The pick up folder would be the "root" folder for us.

2. After root folder selected, it picks up the first sub folder (level1) and set the its folder view to X, where is is the name of the folder view defined in Outlook selectable view settings.

- X name can be set in the code as many folder views exist.

3. After this first subfolder folder view set, it check is there is any sub-sub folder (level2) and set the its folder view to Y, where is is the name of the folder view defined in Outlook selectable view settings.

- It stops going any deeper, so it wont goo any deper then level 2.
- Y name can be set in the code as many folder views exist.

4. After this, it picks up the second subfolder (level 1) in root, and it going on until it is finished with the whole content of the selected (so NOT the complete PST,just the selected) root folder content.

BIG BIG thank you for your time and help,


Moore
 

D.Moore

Senior Member
Outlook version
Outlook 2016 64 bit
Email Account
Office 365 Exchange
#3
So basically, you want to replicate the All View to These folders command and select 2 levels of subfolders?
Forgive me that I am unable to comfirm with a simple YES, as I am not 100% sure I understand you, but I am trying to rephrase my question in what I need:

I store my emails in a way, that i create a folder for each year (root), then I create subfolders for each subjects received email (level1), and I add a subfolder (level2) to each with the sent email. (please see attached image).

I need to set level 1 and 2 folder views. So, I create in outlook a folder view for inbox items folder type (level1) and an other one for sent itmes folder type (level 2).

I need to assign/apply these folder views on each folder respectively and recursively and only on the selected root folder level 1 and 2 subfolders.

One more thing, not all level 1 has level 2 subfolder.

Am I was able to explain it a bit better?

Terribly sorry, if seems to be complicated, Inhave no intention to waste your time, As I am very happy and thanksful for your kind help.

Many Thanks,

Moore

5B8AE34E-F6DC-4D73-A275-97665B5FB218.jpeg
 
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
#4
So you want to apply the view unless the folder name is Sent? As long as the sent folder (and only the sent folder) begins with a word only used for the sent folders, it might be easier just to apply the view to all folders, except those beginning with 'sent'. (You could apply a different view to the ones starting with that word).

I have several samples here (#2 and 3 in the article) should work, just need to add an if statement.
Apply a View to a Folder using a Macro
 

D.Moore

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

BIG thank you for your amazing guidance and example help.

Thanks to your kind help, I was able to puzzle together the following perfectly working code below. I am sure it is far from perfect, and you could do it in a much easier way, but at least i was working hard with it for couple of hours. LOL.

Code:
Sub SetViewFolders()
 
 Dim CurrentFolder As Outlook.Folder
 Dim i As Long
 Dim objViews As Views
 Dim objView As View
 
 Dim xNameSpace As NameSpace
 Dim xPickFolder As Folder
 Dim xSubFolder As Folder
 
 Dim SubFolder As Outlook.Folder
 Dim ii As Long
  
 On Error Resume Next

'pick folder dialog
 Set xNameSpace = Outlook.Application.Session
 Set xPickFolder = xNameSpace.PickFolder

 If TypeName(xPickFolder) = "Nothing" Then Exit Sub

 Set CurrentFolder = xPickFolder
 
 'load all root folder's level 1 folder
 For i = CurrentFolder.Folders.Count To 1 Step -1
 
  Set olNewFolder = CurrentFolder.Folders(i)
    
    For Each olNewFolder In CurrentFolder.Folders

    If olNewFolder.DefaultItemType = olMailItem Then
 
        Set objViews = olNewFolder.Views
        
        If olNewFolder.Name Like "*Küldött*" Then
        
          Set objView = objViews.Item("!Sent Items - Outbox!")
          objView.Apply
          
          Else
        
          Set objView = objViews.Item("!Inbox - Subfolders!")
          objView.Apply
          
        End If
        
        'load level 1 folder subfolders
        Set SubFolder = olNewFolder
        
        For ii = SubFolder.Folders.Count To 1 Step -1

         Set olNewSubFolder = SubFolder.Folders(ii)
        
           For Each olNewSubFolder In SubFolder.Folders
          
           If olNewSubFolder.DefaultItemType = olMailItem Then
          
                Set objViews = olNewSubFolder.Views
              
                If olNewSubFolder.Name Like "*Küldött*" Then
        
                Set objView = objViews.Item("!Sent Items - Outbox!")
                objView.Apply
          
                Else
        
                Set objView = objViews.Item("!Inbox - Subfolders!")
                objView.Apply
          
                End If
          
           End If
        
         Next
        
        Next ii
    
    End If
    
  Next

 Next i

Set xPickFolder = Nothing
Set xSubFolder = Nothing
Set xNameSpace = Nothing

End Sub

May you allow me, 1 more question ?

Background:

We were forced to migrate from exchange 2013 to 2016.

This resulted a "normal" side effect, that older emails "From" part of the header (which were GAL address book senders) are kept the Gal names, BUT lost the email address behind. Problem is, that this in on mobile devices looks like the sender is named as: FYDIBOHF23SPDLT.

BUT

Since the outlook 2016 still shows the correct GAL names at the sender part, just the email missing, I can still identified, which email sender name belongs to which email address. E.g. define, e.g.:

Outlook show: Moore = coolice@freemail.hu
... and so on ...

So, my question:

Would it be technically possible with a VBA macro to "scan" all emails in a folder, and where the sender and check the sender name, and according to the name add back to the email header sender part the email address defined in the code manually?

Many many thanks for your time and kind help,

Moore
 
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
#6
This resulted a "normal" side effect, that older emails "From" part of the header (which were GAL address book senders) are kept the Gal names, BUT lost the email address behind. Problem is, that this in on mobile devices looks like the sender is named as: FYDIBOHF23SPDLT.
That doesn't sound like a normal side effect. Depending on how the migration was done, you might lose the GAL entry and the address is shown as the Exchange x500 address (a long ugly thing containing the code you posted):
/O=EXCHANGELABS/OU=EXCHANGE ADMINISTRATIVE GROUP (FYDIBOHF23SPDLT)/CN=RECIPIENTS/CN=8D4C60CBBB4B4A05BE56B66FB940DCC4-alias

I have never tried to do what you want (correct: I've changed the display name, not the address ) - I do know that to change the address, you'd need to use Redemption (from outlookspy folks) - straight VBA cant change the header. If the reason you're seeing is the x500, is because they moved to a new server (rather than upgrade) and created new mailboxes, it might be possible to do a look up but the display names and or aliases will need to match as we won't have a smtp address to compare - but it will be slow. Very slow. If there are specific messages that you want to check (such as from a boss or coworker you send / receive a lot of mail with), it would be faster to do just their messages.

I have this macro - How to change the From field on incoming messages - which does the display name. It could be changed to do the address, doing a contact lookup. I believe you'd use this propertyAccessor:
PR_SENT_REPRESENTING_EMAIL_ADDRESS - I'm not sure what the constant is offhand but its this property: "http://schemas.microsoft.com/mapi/proptag/0x0065001E" -

As written, it doesn't loop through all mail - but that isnt that difficult to do. I have a code sample to loop and Michael has one at vboffice.com - and actually, if the problem is just when you reply, you could use the macro to update as needed, rather than fixing every message.
 
Last edited:

D.Moore

Senior Member
Outlook version
Outlook 2016 64 bit
Email Account
Office 365 Exchange
#7
Thank you! I checked Redemption, but I am just not there yet. I need to fix all other VBA issues first to get much more practice on it, LOL. So, I get to an other simple task, in which I would like to ask your help on if possible:

I need to move all mail items from a shared mailbox Sent Items folder to my main mailbox Sent items folder. I did a search on the forum first, to not ask something, what others asked first, and I had found excellent resources in your earlier answers.

Code:
Sub MoveMessage()

    Dim objNS As Outlook.NameSpace
    Dim objSourceFolder As Outlook.MAPIFolder
    Dim objDestFolder As Outlook.MAPIFolder
    Dim objItem As Outlook.MailItem
    Dim objOwner As Outlook.Recipient
   
    Set objNS = Application.GetNamespace("MAPI")

    Set objOwner = objNS.CreateRecipient("test@domain.com")
    objOwner.Resolve

    If objOwner.Resolved Then

'##### ALL GOOD TILL HERE, ACCORDING TO DEBUG #####
       
        Set objSourceFolder = objNS.GetSharedDefaultFolder(objOwner, olFolderSentMail)
    MsgBox objSourceFolder.FolderPath
       
        Set objDestFolder = objNS.GetDefaultFolder(olFolderSentMail)
   
        'loop will be added here
            Set objItem = Application.ActiveExplorer.Selection.Item(1)
            objItem.Move objDestFolder
        'loop end
   
    End If

    Set objSourceFolder = Nothing
    Set objDestFolder = Nothing
    Set objNS = Nothing
    Set objOwner = Nothing

End Sub
Using the debugger, I can positively confirm, that I was able to access the shared mailbox.

BUT, the code throw an error at this line:

Set objSourceFolder = objNS.GetSharedDefaultFolder(objOwner, olFolderSentMail)

and I just cant figure it out why, thought I did extensive search on it.

Could you help me please, what am I missing here ?

BIG thank you for your time and help,

Moore
 
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
#8
The mailbox is in your profile as a shared mailbox - as in, you can see the Sent folder?

What is the error message?
 

D.Moore

Senior Member
Outlook version
Outlook 2016 64 bit
Email Account
Office 365 Exchange
#9
The mailbox is in your profile as a shared mailbox - as in, you can see the Sent folder?

What is the error message?
Yes, it is a shared mailbox, AND if by adding an MsgBox objOwner, it is clearly indicate, that shared mailbox name. Addition to this, if I replace "
olFolderSentMail" with "oLFolderInbox", I can access it without any trouble. I also checked Sent Items folder permissions and exactly the same as Inbox.

Error message attached.

9111.png
 
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
#10
Hmmm. From NameSpace.GetSharedDefaultFolder Method (Outlook)
(The constants olFolderDeletedItems , olFolderOutbox , olFolderJunk , olFolderConflicts , olFolderLocalFailures , olFolderServerFailures , olFolderSyncIssues , olPublicFoldersAllPublicFolders , olFolderRssSubscriptions , olFolderToDo , olFolderManagedEmail , and olFolderSentMail cannot be specified for this argument.)

You'll need to do it a different way.... I wonder if this will work.
Set objSourceFolder = objNS.GetSharedDefaultFolder(objOwner, olFolderInbox)
Set objSourceFolder = objSourceFolder.Parent.Folders("Sent Items")
 

D.Moore

Senior Member
Outlook version
Outlook 2016 64 bit
Email Account
Office 365 Exchange
#11
Yeah, again, you were right! That did a trick, BUT for some reason it is only moving 1 message, then it stops. Debugger does not raise an error, but it is clear, that the For is only running once. This is drive me crazy, as in the other codes I did, I never had a problem with For Each expression. May I ask if you could spot what am I doing wrong ? (I also tried to define ObjectItem and ObjectItems as MailItems, but no luck...)

Code:
Sub MoveSentMessage()

 Dim i As Long
 Dim ItemsCount As Integer

 Dim objNS As Outlook.NameSpace
 Dim objSourceFolder As Outlook.MAPIFolder
 Dim objDestFolder As Outlook.MAPIFolder
 Dim objItem As Object
 Dim objItems As Object
  
    Set objNS = Application.GetNamespace("MAPI")

    Set objOwner = objNS.CreateRecipient("test@domain.com")
    objOwner.Resolve

    If objOwner.Resolved Then
      
        Set objSourceFolder = objNS.GetSharedDefaultFolder(objOwner, olFolderInbox)
        Set objSourceFolder = objSourceFolder.Parent.Folders("Sent Items")
        
        Set objDestFolder = objNS.GetDefaultFolder(olFolderSentMail)
        
        ItemsCount = objSourceFolder.Items.Count
              
        If ItemsCount Then
            
            Set objItems = objSourceFolder.Items
            
            For Each objItem In objItems
                
                objItem.Move objDestFolder
                
            Next
            
        End If
  
    End If

 Set objSourceFolder = Nothing
 Set objDestFolder = Nothing
 Set objNS = Nothing
 Set objItem = Nothing
 Set objItems = Nothing

End Sub
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
#12
This line in your original post would only process the selected message-
Set objItem = Application.ActiveExplorer.Selection.Item(1)

But you removed that line... unless the move is messaging up the count. Usually its recommended to count backwards when moving or deleting messages.

If ItemsCount Then
For i = ItemsCount To 1 Step -1
Set objItem = objSourceFolder.Items.Item(i)
objItem.Move objDestFolder
Next
End IF

Do you want to run it manually or automatically? if you convert it to an item add macro, it will run when any new items is added.
 

D.Moore

Senior Member
Outlook version
Outlook 2016 64 bit
Email Account
Office 365 Exchange
#13
This line in your original post would only process the selected message-
Set objItem = Application.ActiveExplorer.Selection.Item(1)

But you removed that line... unless the move is messaging up the count. Usually its recommended to count backwards when moving or deleting messages.

If ItemsCount Then
For i = ItemsCount To 1 Step -1
Set objItem = objSourceFolder.Items.Item(i)
objItem.Move objDestFolder
Next
End IF

Do you want to run it manually or automatically? if you convert it to an item add macro, it will run when any new items is added.
Diane, you are a super Angel! THANK YOU!

The short answer: because I am an idiot.
The long answer: because I tried everything with Debugging, and I found the For Each expression to work more faster and stable.

BUT, my problem is, that the Debugging seems to be confusing sometimes. I know it is sounds strange and dummy, but I experienced the debugger to stuck on the very same code (no change at all), which one worked perfectly at an other time. Based on your superior help, I was able to create some codes, and in the debugger I saw, that For Each was 5x faster than for i = etc... I know it is my illusion, but thats why I asked you. Also, I am trying to read and learn, and i dont understand, why the For Each is not working in this case, while it is perfect in others. But i hope I will get it, when i learn more.

I assume you have a magic ball seeing the future, as your suggestion is exactly what i wanted to ask from you, how can i schedule a VBA macro to run, but converting into an item macro, is the best option for sure. I found an other article about it based on search, so I know I have to add it to ThisOutlookSession, but the example was too complex, and I would like to leave out the "rubbish" to keep it as simple and neat as possible.

This is what I have in my ThisOutlookSession, (you most probably not remember, but this was the very first code I wrote with your help, which is asking, where I want to save the Sent email) :

Code:
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
  
Dim xNameSpace As NameSpace
Dim xPickFolder As Folder

On Error Resume Next

    Set xNameSpace = Outlook.Application.Session
    Set xPickFolder = xNameSpace.PickFolder

    If TypeName(xPickFolder) = "Nothing" Then Exit Sub

    Set Item.SaveSentMessageFolder = xPickFolder

Set xPickFolder = Nothing
Set xNameSpace = Nothing

End Sub
Could you help me please, how can I add this new MoveSentMessage() code into it as simple as possible to run automatically ?

Also, may I ask one more question: do you know if possible to read out the LAST line from an email arrived and add it to an existing TXT file as append with VBA without Redemption, so pure VBA? (I have an email, which is keep growing by every arrival, when a new line added to the end of the email, its a log file, 1 line each time.)
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
#14
BUT, my problem is, that the Debugging seems to be confusing sometimes.
You aren't alone with this idea - at times it confuses me too. :)

For each will be faster, but it may fail since you are moving /deleting. If you are just looking at or changing properties, it wouldn't be a problem.


do you know if possible to read out the LAST line from an email arrived and add it to an existing TXT file as append with VBA without Redemption, so pure VBA?
Sure. The big thing is finding the beginning of the last line.... once you get that, it's easy.
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
#16
Not tested... but I think I got it right. Not responsible for any typos. :D :D

This will move new items as they hit the sent folder.

Code:
Option Explicit
Private objNS As Outlook.NameSpace
Private WithEvents objItems As Outlook.Items
Dim objDestFolder As Outlook.Folder

Private Sub Application_Startup()
 
Dim objSourceFolder As Outlook.Folder
Set objNS = Application.GetNamespace("MAPI")

'Set the folder and items to watch:
   Set objOwner = objNS.CreateRecipient("test@domain.com")
    objOwner.Resolve

    If objOwner.Resolved Then
        Set objSourceFolder = objNS.GetSharedDefaultFolder(objOwner, olFolderInbox)
        Set objSourceFolder = objSourceFolder.Parent.Folders("Sent Items")
   End If

' we can set the destination folder here or in the itemadd
Set objDestFolder = objNS.GetDefaultFolder(olFolderSentMail)

Set objItems = objSourceFolder.Items
Set objSourceFolder  = Nothing
End Sub


Private Sub objItems_ItemAdd(ByVal Item As Object)
    Item.Move objDestFolder
End Sub
 

D.Moore

Senior Member
Outlook version
Outlook 2016 64 bit
Email Account
Office 365 Exchange
#17
THANK YOU !! It took couple of hours, but thanks to your help, I was able to put it together, even more, I added all my shared folders to collect Sent Items.
But, there is one problem, let me explain:
I have 2 types of shared folders:
A) Added mail boxes within the very same exchange account. Here, I only stup my main account, and the additional mailboxes shows up right away >>>> All working perfectly!

B) Added as mail box in an other exchange account. Here, I need to added with separate user/psw. >>>>> This is the one, which, doesnt get resolved by the code this part:

Set objOwner = objNS.CreateRecipient("test@domain.com")
objOwner.Resolve

Debug shows, that it does not get Resolved.

I triple checked that email is correct. I also tried with name instead of email.

May I ask if you have any idea?

Many many thanks,

Moore
 

D.Moore

Senior Member
Outlook version
Outlook 2016 64 bit
Email Account
Office 365 Exchange
#19
Yeah, that's what i thought, but for some reason, when I implemented in ThisOutlookSession, it ALWAYS run into GetFolderPath_Error. (I debugged it with MsgBox-es)

Code:
Private objNS As Outlook.NameSpace
Private WithEvents objItemsMADTATU As Outlook.Items
Private WithEvents objItemsTARE As Outlook.Items
Private WithEvents objItemsSALE As Outlook.Items
Private WithEvents objItemsRINGEE As Outlook.Items
Private WithEvents objItemsPRIMUS As Outlook.Items
Private WithEvents objItemsPOLAR As Outlook.Items
-------------------------------------------------------------------------------------------------------------
Private Sub Application_Startup()

Dim objOwner As Outlook.Recipient
Dim objSourceFolderMADTATU As Outlook.MAPIFolder
Dim objSourceFolderTARE As Outlook.MAPIFolder
Dim objSourceFolderSALE As Outlook.MAPIFolder
Dim objSourceFolderRINGEE As Outlook.MAPIFolder
Dim objSourceFolderPRIMUS As Outlook.MAPIFolder
Dim objSourceFolderPOLAR As Outlook.MAPIFolder
  
On Error Resume Next

    Set objNS = Application.GetNamespace("MAPI")
    Set objOwner = objNS.CreateRecipient("test@test1.com")
    objOwner.Resolve

    If objOwner.Resolved Then
    
        Set objSourceFolderMADTATU = objNS.GetSharedDefaultFolder(objOwner, olFolderInbox)
        Set objSourceFolderMADTATU = objSourceFolderMADTATU.Parent.Folders("Sent Items")
        Set objItemsMADTATU = objSourceFolderMADTATU.Items
  
    End If
  
    Set objNS = Application.GetNamespace("MAPI")
    Set objOwner = objNS.CreateRecipient("test@test2.com")
    objOwner.Resolve

    If objOwner.Resolved Then
    
        Set objSourceFolderTARE = objNS.GetSharedDefaultFolder(objOwner, olFolderInbox)
        Set objSourceFolderTARE = objSourceFolderTARE.Parent.Folders("Sent Items")
        Set objItemsTARE = objSourceFolderTARE.Items
  
    End If
  
    Set objNS = Application.GetNamespace("MAPI")
    Set objOwner = objNS.CreateRecipient("test@test3.com")
    objOwner.Resolve

    If objOwner.Resolved Then
    
        Set objSourceFolderSALE = objNS.GetSharedDefaultFolder(objOwner, olFolderInbox)
        Set objSourceFolderSALE = objSourceFolderSALE.Parent.Folders("Sent Items")
        Set objItemsSALE = objSourceFolderSALE.Items
  
    End If
  
    Set objNS = Application.GetNamespace("MAPI")
    Set objOwner = objNS.CreateRecipient("test@test4.com")
    objOwner.Resolve

    If objOwner.Resolved Then
    
        Set objSourceFolderPRIMUS = objNS.GetSharedDefaultFolder(objOwner, olFolderInbox)
        Set objSourceFolderPRIMUS = objSourceFolderPRIMUS.Parent.Folders("Sent Items")
        Set objItemsPRIMUS = objSourceFolderPRIMUS.Items
  
    End If
  
    Set objNS = Application.GetNamespace("MAPI")
    Set objOwner = objNS.CreateRecipient("test@test5.com")
    objOwner.Resolve

    If objOwner.Resolved Then
    
        Set objSourceFolderRINGEE = objNS.GetSharedDefaultFolder(objOwner, olFolderInbox)
        Set objSourceFolderRINGEE = objSourceFolderRINGEE.Parent.Folders("Sent Items")
        Set objItemsRINGEE = objSourceFolderRINGEE.Items
  
    End If
  
    Set objNS = Application.GetNamespace("MAPI")
    Set objItemsPOLAR = GetFolderPath("test@test6.com\Sent Items").Items

Set objOwner = Nothing
Set objSourceFolderMADTATU = Nothing
Set objSourceFolderTARE = Nothing
Set objSourceFolderSALE = Nothing
Set objSourceFolderRINGEE = Nothing
Set objSourceFolderPRIMUS = Nothing
Set objSourceFolderPOLAR = Nothing

End Sub
-------------------------------------------------------------------------------------------------------------
Function GetFolderPath(ByVal FolderPath As String) As Outlook.Folder

Dim i As Integer

Dim FoldersArray As Variant

Dim objFolder As Outlook.MAPIFolder
Dim objSubFolders As Outlook.MAPIFolder
      
On Error GoTo GetFolderPath_Error

    If Left(FolderPath, 2) = "\\" Then

        FolderPath = Right(FolderPath, Len(FolderPath) - 2)

    End If
  
    FoldersArray = Split(FolderPath, "\")
  
    Set objFolder = Application.Session.Folders.Item(FoldersArray(0))
  
    If Not objFolder Is Nothing Then
      
        For i = 1 To UBound(FoldersArray, 1)

            Set objSubFolders = objFolder.Folders
            Set objFolder = objSubFolders.Item(FoldersArray(i))

            If objFolder Is Nothing Then
              
                Set GetFolderPath = Nothing
          
            End If
      
        Next
  
    End If
  
    Set GetFolderPath = objFolder 'Return the objFolder

Exit Function

GetFolderPath_Error:

    Set GetFolderPath = Nothing

Exit Function
  
Set FoldersArray = Nothing
Set objFolder = Nothing
Set objSubFolders = Nothing
  
End Function
-------------------------------------------------------------------------------------------------------------
Private Sub objItemsMADTATU_ItemAdd(ByVal Item As Object)

Dim objDestFolder As Outlook.MAPIFolder

On Error Resume Next
  
    Set objDestFolder = objNS.GetDefaultFolder(olFolderSentMail)

    Item.Move objDestFolder
  
Set objDestFolder = Nothing
  
End Sub
-------------------------------------------------------------------------------------------------------------
Private Sub objItemsTARE_ItemAdd(ByVal Item As Object)

Dim objDestFolder As Outlook.MAPIFolder

On Error Resume Next
  
    Set objDestFolder = objNS.GetDefaultFolder(olFolderSentMail)
  
    Item.Move objDestFolder
  
Set objDestFolder = Nothing
  
End Sub
-------------------------------------------------------------------------------------------------------------
Private Sub objItemsSALE_ItemAdd(ByVal Item As Object)

Dim objDestFolder As Outlook.MAPIFolder

On Error Resume Next
  
    Set objDestFolder = objNS.GetDefaultFolder(olFolderSentMail)
  
    Item.Move objDestFolder

Set objDestFolder = Nothing
  
End Sub
-------------------------------------------------------------------------------------------------------------
Private Sub objItemsPRIMUS_ItemAdd(ByVal Item As Object)

Dim objDestFolder As Outlook.MAPIFolder
  
On Error Resume Next
  
    Set objDestFolder = objNS.GetDefaultFolder(olFolderSentMail)
  
    Item.Move objDestFolder
  
Set objDestFolder = Nothing
  
End Sub
-------------------------------------------------------------------------------------------------------------
Private Sub objItemsRINGEE_ItemAdd(ByVal Item As Object)

Dim objDestFolder As Outlook.MAPIFolder
  
On Error Resume Next
  
    Set objDestFolder = objNS.GetDefaultFolder(olFolderSentMail)
  
    Item.Move objDestFolder
  
Set objDestFolder = Nothing
  
End Sub
-------------------------------------------------------------------------------------------------------------
Private Sub objItemsPOLAR_ItemAdd(ByVal Item As Object)

Dim objDestFolder As Outlook.MAPIFolder
  
On Error Resume Next
  
    Set objDestFolder = objNS.GetDefaultFolder(olFolderSentMail)

    Item.Move objDestFolder
  
Set objDestFolder = Nothing
  
End Sub
Any Idea, what am i messed up? Because I checked it quadruple times, and seems to be implemented correctly. All folderwatch forks, except the one calls objItemsPOLAR_ItemAdd , which is utilizing the getfolderpath function.
 

Similar threads

Top