I am trying to run a VBScript that searches all the Incoming messages for a specific string on the subject field and replaces it with something else but keeping the rest of the subject content. So far, this is my code but im not getting any results.
Incoming mails subject: [EXTERNAL] abcdfed ghijk lmno
What i need: [*] abcdfed ghijk lmno
Sub RunAScriptRuleRoutine(MyMail As MailItem)
Dim strID As String
Dim olNS As Outlook.NameSpace
Dim msg As Outlook.MailItem
Dim rply As Outlook.MailItem
strID = MyMail.EntryID
Set olNS = Application.GetNamespace("MAPI")
Set msg = olNS.GetItemFromID(strID)
' do stuff with msg, e.g.
msg.Subject = Replace(msg.Subject, "[EXTERNAL]", "[*]")
msg.Save
Set msg = Nothing
Set olNS = Nothing
End Sub
I will appreciate your help
Changes to the subject for received messages will only be reflected in the header UI. You also have to change the MailItem.ConversationTopic value, but it is read-only. However, you can use PropertyAccessor.SetProperty("http://schemas.microsoft.com/mapi/proptag/0x0070001F", "New subject") to update it.
Related
I get some items duplicated when I iterate the Inbox of an IMAP folder looking for messages with a particular subject line and sender e-mail address. For instance, in Outlook application I can see just 3 messages passing the filter, but the following script results in 5 messages with one of the messages read 3 times. I have been checking and each duplicated element has different ConversationID even when the subject line and body text is the same. From where those duplicates are coming if I cannot see them in the Outlook panel?
Thanks in advance!
Private Sub GetFromFolder(ofldr)
Dim oItem
Dim oSubFldr
Dim sBadEmail
Dim matches
Dim colMail
Dim i
Dim key
Set colMail = CreateObject("Scripting.Dictionary")
i = 1
' Process all mail items in this folder
For Each oItem In ofldr.Items
If TypeName(oItem) = "MailItem" Then
With oItem
If StrComp(.Subject, g_SubjectLine) = 0 And StrComp(.SenderEmailAddress, g_SystemEmailAddress) = 0 Then
'ProcessQuery .Body
colMail.Add i, oItem
i = i + 1
End If
End With
End If
Next
For Each key In colMail.Keys
ProcessQuery colMail.Item(key).Body
Next
set colMail = Nothing
End Sub
I want to use a macro in outlook 2013. This macro is supposed to mark any emails arriving a specific folder ('work' folder) as read. I'm not familiar with vb. Any help/guidance is much appreciated!
No sure, I have heard this one before of wanting emails automatically read. You have two options:
a) Use Ctrl-A (select all mail in folder), Ctrl-Q (mark selection as read)
b) Use New Email Event something like:
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
vID = Split(EntryIDCollection, ",")
Dim i as Long, objMail as Outlook.MailItem
For i = 0 To UBound(vID)
Set objMail = Application.Session.GetItemFromID(vID(i))
objMail.Unread = False
Next i
End Sub
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
' version to select folder
Dim i As Long, objMail As Outlook.MailItem, mpfInbox As Outlook.Folder
Set mpfInbox = Application.GetNamespace("MAPI").Folders("YOURACCOUNT").Folders("[Gmail]").Folders("Sent Mail")
For i = 1 To mpfInbox.Items.Count
If mpfInbox.Items(i).Class = olMail Then
Set objMail = mpfInbox.Items.Item(i)
objMail.UnRead = False
End If
Next i
End Sub
You can set up a rule which can trigger your macro.
I'd not suggest working with the NewMailEx event because it is not fired in some case and may introduce issues. See Outlook NewMail event unleashed: the challenge (NewMail, NewMailEx, ItemAdd) for more information.
Problem: Handle the incoming emails using vbscript.
Outlook Version: Outlook 2000
Description: I cannot use VBA for this as I believe Outlook 2000 doesn't let you run a VBA script from the rules wizard and hence I have to use the Run a Program | VBScript method.
What I know: I know how to handle email from VBA like this
Sub Sample(MyMail As MailItem)
Dim strID As String, olNS As Outlook.NameSpace
Dim olMail As Outlook.MailItem
strID = MyMail.EntryID
Set olNS = Application.GetNamespace("MAPI")
Set olMail = olNS.GetItemFromID(strID)
'~~> Rest of the code
Set olMail = Nothing
Set olNS = Nothing
End Sub
I also know how to run the vbscript on the email which is already in the inbox. To run a vbscript in OL2000, you have to use Run A Program and point it to the vbs file. The Run A Script is not available in OL2000.
What I do not know: And this is where I need help. How to get the mail object which has not hit the mail inbox in VBS. Once I get the object then I can do the rest of the necessary operations.
You are correct that OL2000 cannot run a VBA macro from a rule, if this article is to be believed.
Here's how I handle incoming emails. It does use VBA but as far as I know, there isn't a way to do so in VBScript.
Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub Items_ItemAdd(ByVal item As Object)
On Error Goto ErrorHandler
Dim Msg As Outlook.MailItem
If TypeName(item) = "MailItem" Then
Set Msg = item
'~~> do something with the new message here
End If
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub
This code should be pasted into the ThisOutlookSession module, then Outlook should be restarted.
How do I write a VBA method that replaces the subject if there is a specific word in the subject. This code would find a certain key word (different than the subject key word) in the body of the email. It would then replace the subject line with 13 charactars after the key word found in the body of the text.
The below was already found but doesn't mention how to find anything in the body of the email. And I don't get the MAPI reference.
Any help would truly be appreciated
Thank You in advance for any assistance
Rick
Sub RewriteSubject(MyMail As MailItem)
Dim mailId As String
Dim outlookNS As Outlook.NameSpace
Dim myMailItem As Outlook.MailItem
mailId = MyMail.EntryID
Set outlookNS = Application.GetNamespace("MAPI")
Set myMailItem = outlookNS .GetItemFromID(mailId)
' Do any detection here
mailItem.Subject = "Dept - " & mailItem.Subject
myMailItem.Save
Set mailItem = Nothing
Set outlookNS = Nothing
End Sub
If it is for all new messages then you can use the following
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim v As Variant
For Each v In Array("first", "second")
If InStr(1, Item.Subject, v, vbTextCompare) <> 0 Then
SearchForAttachWords = True
End If
Next
If SearchForAttachWords = True Then
Item.Subject = "Whatever subject you want"
End If
End Sub
Hope this helps.
How can I send an email to a group of recipients with CDO? I'm using VB6.
You can list multiple recipients on the .To line by separating them with ";", for example:
Set m = Server.CreateObject("CDO.Message")
m.Subject="subject..."
m.From="sender#example.com"
m.To="some#email.com;other#email.com;third#email.com"
m.TextBody="Message"
m.Send
This works in Office 97 and whatever Exchange we had back then:
Dim oOApp As Outlook.Application
Dim newMail As Outlook.MailItem
Set oOApp = CreateObject("Outlook.Application")
Set newMail = oOApp.CreateItem(olMailItem)
With newMail
.Display
.Body = whatever
.Subject = whatever
.Attachments.Add whatever
.Recipients.Add (whomever)
.Send
End With
Set newMail = Nothing
Set oOApp = Nothing