Update subject of incoming mail - vba

I'm trying toremove the RES: and ENC: (response and forwarding in Portuguese) upon receiving a message (by rule already sent to the folder referenced in the code).
Although the code works, in msgbox the subject is displayed without the prefixes, it does not refresh the subject.
I guess it has something to do with the ByVal or ByRef; i've tried both, and it goes as I described with ByVal, while with the byRef doesn't even run.
Here's the code:
Option Explicit
Private WithEvents inboxItems As Outlook.Items
Private Sub Application_Startup()
Dim outlookApp As Outlook.Application
Dim objectNS As Outlook.NameSpace
Set outlookApp = Outlook.Application
Set objectNS = outlookApp.GetNamespace("MAPI")
Set inboxItems =
objectNS.GetDefaultFolder(olFolderInbox).Folders("TESTA").Items
End Sub
Private Sub inboxItems_ItemAdd(ByVal Item As Object)
Dim Msg As Outlook.MailItem
Dim assunto As String
If TypeName(Item) = "MailItem" Then
assunto = Replace(Replace(Item.Subject, "RES: ", ""), "ENC: ", "")
Item.Subject = assunto
MsgBox (assunto)
End If
End Sub

Just forget ByVal and ByRef.
Add this string after last MsgBox:
Item.Save

Related

Auto open incoming mail from internal email address

I'm trying to auto open incoming mails from a specific address.
Found code online which works if I send from Gmail but not from my domain.
Public WithEvents objInbox As Outlook.Folder
Public WithEvents objInboxItems As Outlook.Items
Private Sub Application_Startup()
Set objInbox = Outlook.Application.Session.GetDefaultFolder(olFolderInbox)
Set objInboxItems = objInbox.Items
End Sub
'Occurs when incoming emails arrive in Inbox
Private Sub objInboxItems_ItemAdd(ByVal Item As Object)
Dim objMail As Outlook.MailItem
Dim strSenders As String
Dim varSenders As Variant
Dim i As Long
If TypeOf Item Is MailItem Then
Set objMail = Item
'Change the specific persons
strSenders = "addr#Mydomain.com;addr#ExDomain.com"
varSenders = Split(strSenders, ";")
'Open the emails from specific persons
For i = 0 To UBound(varSenders)
If objMail.SenderEmailAddress = varSenders(i) Then
objMail.Display
Exit For
End If
Next
End If
End Sub
This question has been asked
HERE. The solution didn't work.
Could it be premmisions? GPO? Is there an alternative?
Your script expects an SMTP address, but internal emails use EX type addresses. You need to use MailItem.Sender.GetExchangeUser.PrimarySmtpAddress for the EX type senders.
Modify your script as follows (off the top of my head):
Dim senderAddress As String
if objMail.SenderEmailType = "SMTP" Then senderAddress = objMail.SenderEmailAddress
ElseIf objMail.SenderEmailType = "EX" Then senderAddress = objMail.Sender.GetExchangeUser.PrimarySmtpAddress
Else senderAddress = ""
For i = 0 To UBound(varSenders)
If senderAddress = varSenders(i) Then
objMail.Display
Exit For
End If
Next

Declaring WithEvents variables - Compilation error: invalid characteristics in Sub or Function"

I have two sets of code. The first code adds a preset BCC address triggered by a button. The second code enables filing of emails, by tagging/categorizing the sent email, copying that sent email and then moving the copy to the folder indicated in pickfolder.
The two codes work separately.
When I paste both codes in ThisOutlookSession, the second one does not work. The error is (loosely translated from Dutch): "compilation error: invalid characteristics in Sub or Function" which relates to all three declarations (Dim WithEvents objInspectors As Inspectors, Dim WithEvents objMyNewMail As MailItem, Dim WithEvents colSentItems As Items)
The full codes:
'button bcc to crm system emailaddress)
Sub AddCRMtoBCC()
Dim objRecip As Recipient
Set oMsg = Application.ActiveInspector.CurrentItem
With oMsg
Set objRecip = oMsg.Recipients.Add("__#__.com")
objRecip.Type = olBCC
objRecip.Resolve
End With
Set oMsg = Nothing
End Sub
'________
'file emails
Dim WithEvents objInspectors As Inspectors
Dim WithEvents objMyNewMail As MailItem
Dim WithEvents colSentItems As Items
Private Sub Application_Startup()
Set objInspectors = Application.Inspectors
Dim NS As Outlook.NameSpace
Set NS = Application.GetNamespace("MAPI")
Set colSentItems = NS.GetDefaultFolder(olFolderSentMail).Items
Set NS = Nothing
End Sub
Private Sub Application_Quit()
Set objInspectors = Nothing
Set objMyNewMail = Nothing
End Sub
Private Sub objInspectors_NewInspector(ByVal Inspector As Inspector)
If Inspector.CurrentItem.Class <> olMail Then Exit Sub
Set objMyNewMail = Inspector.CurrentItem
End Sub
Private Sub objMyNewMail_Send(Cancel As Boolean)
If MsgBox("Are you sure you want to send this message?", vbYesNo + vbQuestion _
, "SEND CONFIRMATION") = vbNo Then
Cancel = True
End If
End Sub
Private Sub colSentItems_ItemAdd(ByVal Item As Object)
If Item.Class = olMail Then
Set Copy = Item.Copy
Set objNS = Application.GetNamespace("MAPI")
Set objFolder = objNS.PickFolder
Copy.Move objFolder
End If
End Sub
When you declare global variables at module level (ThisOutlookSession is a module), all of them should be declared at the top of the module.
thus, move those 3 lines at the top , before the very first sub()
Dim WithEvents objInspectors As Inspectors
Dim WithEvents objMyNewMail As MailItem
Dim WithEvents colSentItems As Items
objMyNewMail_Send() Cancel parameter must be declared ByRef

I want to show Outlook mail body Template in vb.net form

I want to display my outlook Inbox in my vb.net form with navigation like
<< Prev Next>>>
mail body must contain outlook template and display with all useful content like
SenderName
SenderEmail
Datetime
CC
Attchment (if any)
Please help me if anyone have idea about it.
Thanks in advance.
1st result google gave me:
(modified a little)
The basis is there, you can start experimenting.
At least try to create something yourself, than do a repost along with the code you have tried.
Imports System.Reflection
Imports Microsoft.Office.Interop
Module Module1
Sub Main()
' Create Outlook application.
Dim oApp As Outlook.Application = New Outlook.Application()
' Get Mapi NameSpace.
Dim oNS As Outlook.NameSpace = oApp.GetNamespace("mapi")
oNS.Logon("YourValidProfile", Missing.Value, False, True) ' TODO:
' Get Messages collection of Inbox.
Dim oInbox As Outlook.MAPIFolder = oNS.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderInbox)
Dim oItems As Outlook.Items = oInbox.Items
Console.WriteLine("Total : " & oItems.Count)
' Get unread e-mail messages.
oItems = oItems.Restrict("[Unread] = true")
Console.WriteLine("Total Unread : " & oItems.Count)
' Loop each unread message.
Dim oMsg As Outlook.MailItem
Dim i As Integer
For i = oItems.Count To 1 Step -1
oMsg = oItems.Item(i)
Console.WriteLine(i)
Console.WriteLine(oMsg.SenderName)
Console.WriteLine(oMsg.Subject)
Console.WriteLine(oMsg.ReceivedTime)
Console.WriteLine(oMsg.Body)
Console.WriteLine("---------------------------")
Console.ReadLine()
Next
' Log off.
oNS.Logoff()
' Clean up.
oApp = Nothing
oNS = Nothing
oItems = Nothing
oMsg = Nothing
End Sub
End Module
Display in Form:
Imports Microsoft.Office.Interop
Public Class Form1
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Dim oApp As New Outlook.Application
Dim mitem As Outlook.MailItem
mitem = oApp.CreateItemFromTemplate("\\Files\HC_METOD\SVA\meeting.msg")
WebBrowser1.DocumentText = mitem.HTMLBody
End Sub
End Class

Runtime error in outlook macro - Item.senderName

I have the following macro;
Private WithEvents MySents As Outlook.Items
Private Sub Application_Startup()
Set MySents = Session.GetDefaultFolder(olFolderSentMail).Items
End Sub
Private Sub MySents_ItemAdd(ByVal Item As Object)
Dim objNS As Outlook.NameSpace
Dim targetFolder As Outlook.MAPIFolder
Set objNS = Outlook.GetNamespace("MAPI")
If TypeOf Item Is Outlook.MailItem Then
If Item.SenderName = "Sender 1" Then
Set targetFolder = objNS.Folders("Folder 1").Folders("Sent Items")
Set newItem = Item.Copy
newItem.Move targetFolder
End If
If Item.SenderName = "Sender 2" Then
Set targetFolder = objNS.Folders("Folder 2").Folders("Sent Items")
Set newItem = Item.Copy
newItem.Move targetFolder
End If
End If
End Sub
Last week this worked fine. Now when the macro runs I get a "Runtime error -2147221241 (80040107) The operation failed"
Looking at the debugger it fails on;
If Item.SenderName =
If I have a look at Items in the watch window most properties have "The operation failed" in the values.
Most strange about this is the fact that the message still gets copied anyway.
Can anyone see something silly I am doing?
The SenderName property returns a String indicating the display name of the sender for the Outlook item. It is set after the mail item has been sent. New items (unsent) don't have this property set.
You may consider using the SaveSentMessageFolder property which allows to set a Folder object that represents the folder in which a copy of the e-mail message will be saved after being sent. For example, you may handle the ItemSend event where you can set this property.
Sub SetSentFolder()
Dim myItem As Outlook.MailITem
Dim myResponse As Outlook.MailITem
Dim mpfInbox As Outlook.Folder
Dim mpf As Outlook.Folder
Set mpfInbox = Application.Session.GetDefaultFolder(olFolderInbox)
Set mpf = mpfInbox.Folders.Add("SaveMyPersonalItems")
Set myItem = Application.ActiveInspector.CurrentItem
Set myResponse = myItem.Reply
myResponse.Display
myResponse.To = "Eugene Astafiev"
Set myResponse.SaveSentMessageFolder = mpf
myResponse.Send
End Sub

Show MsgBox upon receiving email with specified subject or sender

How do I show a MsgBox or alert upon receiving a message with a specified subject or sender?
I put this procedure in ThisOutlookSession block.
Private Sub olInboxItems_ItemAdd(ByVal Item As Object)
Dim myMail As MailItem
Dim name As String
If TypeOf Item Is MailItem Then
Set myMail = Item
If myMail.Subject Like "*Hello world*" And myMail.Categories = "" Then
MsgBox "Message", vbInformation, "approved"
MailDate = myMail.ReceivedTime
myMail.Categories = "CZEART"
myMail.MarkAsTask (olMarkNoDate)
myMail.Save
End If
End If
End Sub
To test the code, open a mailitem with the required conditions then step through this.
Option Explicit
Private Sub test()
Dim currItem As MailItem
Set currItem = ActiveInspector.currentItem
olInboxItems_ItemAdd currItem
End Sub
Likely though you need this in the ThisOutlookSession module.
Option Explicit
Private WithEvents olInboxItems As Items
Private Sub Application_Startup()
Dim objNS As NameSpace
Set objNS = Application.Session
' instantiate objects declared WithEvents
Set olInboxItems = objNS.GetDefaultFolder(olFolderInbox).Items
Set objNS = Nothing
End Sub
http://www.outlookcode.com/article.aspx?id=62