i checked for my address thinking this could be triggering but i didn't find my address at all.
and then i added
strAddress = ";" (tried few times)
strAddress = "" (tried few times)
and ; at the end of all the email addresses in the text file
but still all the email items from sent folder(5666) are moved to unwanted folder(5666).
also just so you know i have added GetRecipientAddress into new module
Public Sub GetRecipientAddress()
'
http://slipstick.me/9vjgj
Dim currentExplorer As Explorer
Dim Selection As Selection
Dim obj, objMail As Object
Dim objProp As Outlook.UserProperty
Dim strDomain
Dim Recipients As Outlook.Recipients
Dim recip As String
Dim i
Dim prompt As String
Set currentExplorer = Application.ActiveExplorer
Set Selection = currentExplorer.Selection
On Error Resume Next
For Each obj In Selection
Set objMail = obj
strDomain = ""
Set Recipients = objMail.Recipients
For i = Recipients.count To 1 Step -1
recip$ = Recipients.item(i).Address
' To use only the alias from the x.500 address
' If InStr(1, LCase(recip), "/ou=") Then recip = Right(recip, Len(recip) - InStr(1, LCase(recip), "recipients") - 13)
' Use semicolon separator if there is more than 1 address
If i = 1 Then
strDomain = strDomain & recip
Else
strDomain = strDomain & recip & "; "
End If
Next i
Debug.Print strDomain
' Msgbox strDomain
Set objProp = objMail.UserProperties.Add("Recipient Email", olText, True)
objProp.Value = strDomain
objMail.Save
Err.Clear
Next
Set currentExplorer = Nothing
Set obj = Nothing
Set Selection = Nothing
End Sub
and
added this in thisoutlooksession
Dim WithEvents olSent As Items
Private Sub Application_Startup()
Dim NS As Outlook.NameSpace
Set NS = Application.GetNamespace("MAPI")
Set olSent = NS.GetDefaultFolder(olFolderSentMail).Items
Set NS = Nothing
End Sub
Private Sub olSent_ItemAdd(ByVal Item As Object)
' Fromhttp://slipstick.me/1
Dim objProp As Outlook.UserProperty
Dim strDomain As String
Dim Recipients As Outlook.Recipients
Dim recip As String 'Outlook.Recipient
Dim i
strDomain = ""
Set Recipients = Item.Recipients
For i = Recipients.count To 1 Step -1
recip$ = Recipients.Item(i).Address
'If InStr(1, LCase(recip), "/ou=") Then recip = Right(recip, Len(recip) - InStr(1, LCase(recip), "recipients") - 13)
If i = 1 Then
strDomain = strDomain & recip
Else
strDomain = strDomain & recip & "; "
End If
Next i
Set objProp = Item.UserProperties.Add("Recipient Email", olText, True)
objProp.Value = strDomain
Item.Save
Err.Clear
Set objProp = Nothing
Set Recipients = Nothing
End Sub