create macro to add category to email

melfinster · #1 06-10-2019, 10:04 PM

Hello
I want to put a button in the ribbon that assigns a category called "TRIM" to an email. i'd like to do this to an incoming email or an outgoing email. I know I can create a button that runs a macro, could someone please help me write the VBA for the macro

Mel

gmayor · #2 06-11-2019, 04:25 AM

This is fairly straightforward, however categories are case sensitive, so the following assumes "trim", "Trim" or "TRIM" are all intended to equal "TRIM" and so if they exist "TRIM" is not added again.

Code:

Sub Add_Category()
Dim olItem As Object
Dim Arr As Variant
Dim i As Integer
Const strCat As String = "TRIM"
    On Error GoTo err_Handler
    Set olItem = Application.ActiveExplorer.Selection.Item(1)
    If TypeName(olItem) = "MailItem" Then
        Arr = Split(olItem.Categories, ",")
        If UBound(Arr) >= 0 Then
            For i = 0 To UBound(Arr)
                If Trim(UCase(Arr(i))) = strCat Then
                    Beep
                    MsgBox "Already categorised with " & strCat
                    GoTo lbl_Exit
                End If
            Next
        End If
        olItem.Categories = strCat & "," & olItem.Categories
        olItem.Save
    End If
lbl_Exit:
    Set olItem = Nothing
    Exit Sub
err_Handler:
    Beep
    MsgBox "Select a message!"
    Err.Clear
    GoTo lbl_Exit
End Sub

melfinster · #3 06-11-2019, 03:35 PM

Thank you for this. For some reason it's not working for me.

I have a category already labelled 'TRIM'
In VB, I have VbaProject.OTM - ThisOutlookSession with your code

In the Home ribbon, I added a new group and then added your Macro (CategoryButton.ThisOutlookSession.Add_Category) and renamed it.

In the email, I clicked on the new button and it doesn't apply the category.

I must have missed a step somewhere, can you help?

Thank you

Mel

gmayor · #4 06-11-2019, 08:02 PM

Create an ordinary module and move the code to it.
You may need to refer to https://www.gmayor.com/create_and_em...gital_cert.htm in some versions of Outlook or the security will inhibit the macro.

melfinster · #5 06-11-2019, 10:43 PM

great! I got it to work thank you

juacab9 · #6 07-10-2023, 11:48 AM

Option Explicit
Sub ReplyMSG()
Dim olItem As Outlook.MailItem
Dim olReply As MailItem ' Reply

For Each olItem In Application.ActiveExplorer.Selection
Set olReply = olItem.ReplyAll
olReply.HTMLBody = "Am currently working on your quote, I should have it done today or first tomorrow morning. Any question feel to email directly please." & vbCrLf & olReply.HTMLBody
olReply.Display

olReply.Send
Next olItem

Dim obApp As Object
Dim NewEmail As MailItem

Set obApp = Outlook.Application
Set NewEmail = obApp.ActiveInspector.CurrentItem

'If you want to set a specific category to the new email manually
'You can use the following line instead to show the Category dialog
'NewEmail.ShowCategoriesDialog
NewEmail.Categories = "Juan Cabrera”"

Set obApp = Nothing
Set NewEmail = Nothing
End Sub

gmayor · #7 07-10-2023, 11:50 PM

The following is a combination of the two

Code:

Sub ReplyMSG()
Dim olItem As Outlook.MailItem
Dim olReply As MailItem    ' Reply

    For Each olItem In Application.ActiveExplorer.Selection
        Set olReply = olItem.ReplyAll
        olReply.HTMLBody = "Am currently working on your quote, I should have it done today or first tomorrow morning. Any question feel to email directly please." & vbCrLf & olReply.HTMLBody
        olReply.Display
        olReply.Categories = "Juan Cabrera”"
        olReply.Send
    Next olItem
    Set olItem = Nothing
    Set olReply = Nothing
End Sub

juacab9 · #8 07-11-2023, 08:01 AM

Thank for combining the marco for me, but what I want was to send a reply email and i wanted the original message be categorized and not the reply email.

juacab9 · #9 07-14-2023, 03:51 PM

Sub ReplyMSG()
Dim olItem As Outlook.MailItem
Dim olReply As MailItem ' Reply

For Each olItem In Application.ActiveExplorer.Selection
Set olReply = olItem.ReplyAll
olReply.HTMLBody = "Am currently working on your quote, I should have it done today or first thing tomorrow morning. Any questions feel to email directly please. To speed up the process please make sure you have the following on the quote." & vbCrLf & olReply.HTMLBody

<ol>
<li>Item 1</li>
<li>Item 2</li>
<li>Item 3</li>
olCurrent.Display
olCurrent.Categories = "Juan Cabrera"
olReply.Send & Signature
Next olItem
Set olItem = Nothing
Set olReply = Nothing
End Sub

juacab9 · #10 07-14-2023, 04:17 PM

Can you help with his one, want to send a reply email and then categorize the original email am reply to. I would like to add bullets to the reply email also and my signature also.

gmayor · #11 07-15-2023, 01:18 AM

If yo want to add the default signature and the original message, and include bullet points, it is simpler to use the eMail Word editor.
The following will reply to the selected message, categorize the original message and retain your signature,

Code:

Sub ReplyMSG()
'Graham Mayor - https://www.gmayor.com - Last updated - 15 Jul 2023
Dim olItem As Outlook.MailItem
Dim olReply As MailItem    ' Reply
Dim olInsp As Outlook.Inspector
Dim wdDoc As Object
Dim oRng As Object
    
    On Error Resume Next
    Select Case Outlook.Application.ActiveWindow.Class
        Case olInspector
            Set olItem = ActiveInspector.currentItem
        Case olExplorer
            Set olItem = Application.ActiveExplorer.Selection.Item(1)
    End Select

    Set olReply = olItem.ReplyAll
    With olReply
        .BodyFormat = olFormatHTML
        Set olInsp = .GetInspector
        Set wdDoc = olInsp.WordEditor
        Set oRng = wdDoc.Range(0, 0)
        oRng.Text = "Am currently working on your quote, I should have it done today or first tomorrow morning. " & _
                    "Any question, please feel free to email directly."
        oRng.collapse 0
        oRng.Text = vbCr & vbCr & "Item 1" _
                    & vbCr & vbCr & "Item 2" _
                    & vbCr & vbCr & "Item 3"
        olReply.Display
        olReply.Send
    End With
    olItem.Categories = "Juan Cabrera”"
    olItem.Close olSave
lbl_Exit:
    Set olItem = Nothing
    Set olReply = Nothing
    Set olInsp = Nothing
    Set wdDoc = Nothing
    Set oRng = Nothing
    Exit Sub
End Sub

juacab9 · #12 07-17-2023, 08:48 AM

Thank you, this is what I was looking for.

juacab9 · #13 07-17-2023, 04:48 PM

Sub ReplyMSG()
'Graham Mayor - Graham Mayor - Home Page - Last updated - 15 Jul 2023
Dim olItem As Outlook.MailItem
Dim olReply As MailItem ' Reply
Dim olInsp As Outlook.Inspector
Dim wdDoc As Object
Dim oRng As Object

On Error Resume Next
Select Case Outlook.Application.ActiveWindow.Class
Case olInspector
Set olItem = ActiveInspector.CurrentItem
Case olExplorer
Set olItem = Application.ActiveExplorer.Selection.Item(1)
End Select

If TypeName(ActiveExplorer.Selection.Item(1)) = "MailItem" Then
Set oMail = ActiveExplorer.Selection.Item(2)

Set olReply = olItem.ReplyAll
With olReply
.BodyFormat = olFormatHTML
Set olInsp = .GetInspector
Set wdDoc = olInsp.WordEditor
Set oRng = wdDoc.Range(0, 0)
oRng.Text = "Am currently working on your quote, I should have it done today or first tomorrow morning. " & _
"Any question, please feel free to email directly."
oRng.Collapse 0
oRng.Text = vbCr & vbCr & "Item 1" _
& vbCr & vbCr & "Item 2" _
& vbCr & vbCr & "Item 3"
olReply.Display
olReply.Send
End With
olItem.Categories = "Juan Cabrera”"
olItem.Close olSave
lbl_Exit:
Set olItem = Nothing
Set olReply = Nothing
Set olInsp = Nothing
Set wdDoc = Nothing
Set oRng = Nothing
Exit Sub
End Sub

juacab9 · #14 07-17-2023, 05:05 PM

Sorry the last email was probably confusing, when it sends the email it using the email that i dont have access to but i can manually change to my email address, how do i add to the code we already have. I tried the following but i get an error. olreply from = juan cabrera

gmayor · #15 07-18-2023, 03:15 AM

You need the display name of the account and a bit of extra code to use that account e.g.

Code:

Sub ReplyMSG()
'Graham Mayor - https://www.gmayor.com - Last updated - 18 Jul 2023
Dim olItem As Outlook.MailItem
Dim olAccount As Outlook.Account
Dim olReply As MailItem    ' Reply
Dim olInsp As Outlook.Inspector
Dim wdDoc As Object
Dim oRng As Object
Dim bAcc As Boolean
Const strAcc As String = "Juan Cabrera"    'use the display name of the account here

    On Error Resume Next
    Select Case Outlook.Application.ActiveWindow.Class
        Case olInspector
            Set olItem = ActiveInspector.currentItem
        Case olExplorer
            Set olItem = Application.ActiveExplorer.Selection.Item(1)
    End Select

    For Each olAccount In Application.Session.Accounts
        If olAccount.DisplayName = strAcc Then
            bAcc = True
            Set olReply = olItem.ReplyAll
            With olReply
                .BodyFormat = olFormatHTML
                Set olInsp = .GetInspector
                Set wdDoc = olInsp.WordEditor
                Set oRng = wdDoc.Range(0, 0)
                oRng.Text = "Am currently working on your quote, I should have it done today or first tomorrow morning. " & _
                            "Any question, please feel free to email directly."
                oRng.collapse 0
                oRng.Text = vbCr & vbCr & "Item 1" _
                            & vbCr & vbCr & "Item 2" _
                            & vbCr & vbCr & "Item 3"
                .SendUsingAccount = olAccount
                .Display
                .Send
            End With
            Exit For
        End If
        olItem.Categories = "Juan Cabrera"
        olItem.Close olSave
    Next olAccount
    If bAcc = False Then
        MsgBox strAcc & " account not found!", vbCritical
    End If
lbl_Exit:
    Set olItem = Nothing
    Set olReply = Nothing
    Set olInsp = Nothing
    Set wdDoc = Nothing
    Set oRng = Nothing
    Set olAccount = Nothing
    Exit Sub
End Sub

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Create a Userform in Outlook to select a macro for an email template.	snickerbart	Outlook	4	04-17-2015 12:55 PM
Create QuickStep: Save Contact with Category	ilcaa72	Outlook	1	05-20-2014 10:31 AM
Macro to export email to text file on send depending on category	Joe Patrick	Outlook	0	10-19-2012 06:20 PM
How to create a Main category mirrored in Sub category data entry type of solution?	Geza59	Excel	0	10-19-2012 05:44 AM