categories for outgoing email

Iqbal Khan

New Member
Outlook version
Outlook 2013 64 bit
Email Account
POP3
I am trying to set categories to outgoing email in Outlook 2016 based on certain combo box values from the end user.

I am using the below code to add category to outgoing email within the Item send event.

Code:
msg.Categories = msg.Categories & "," & EmailDetails.cmbresponsetype.Value & "-" & EmailDetails.cmblbl.Value & "-" & grp
msg.Save
The above works sometimes but most of the time it does nothing.

Please help
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
does it trigger any errors? (comment out any error handlers you are using )

add a message box (or debug.print) - does it show the values?
Code:
msgbox EmailDetails.cmbresponsetype.Value & "-" & EmailDetails.cmblbl.Value
msg.Categories = msg.Categories & "," & EmailDetails.cmbresponsetype.Value & "-" & EmailDetails.cmblbl.Value & "-" & grp
msg.Save
add debug.print lines after each step - check the immediate window- are they all entered?
 

Iqbal Khan

New Member
Outlook version
Outlook 2013 64 bit
Email Account
POP3
It gives no errors.

I check the code using the step mode, all form values shows but no categories is set for the email.

However sometimes if I run the code in step mode it sets the category but when I run the code it gives blank.

I tried using sleep after the first line of code but no luck.
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
can you post the entire macro? I'll test it and see if i can repro.
 

Iqbal Khan

New Member
Outlook version
Outlook 2013 64 bit
Email Account
POP3
I tested the code again and found that when the email is replied within the reading pane it categories the email but when I open the email in a new window it does not categories it.

I will send you relevant code in sometime.

Thank you.
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
Definitely weird - its usually the other way around - macros apply to open mail, not reading pane compose.
 

Iqbal Khan

New Member
Outlook version
Outlook 2013 64 bit
Email Account
POP3
Hi Diane,

Please find below the code I am using to set the categories.

Thank you for your help.


Code:
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
If EmailDetails.Visible = False Then
    clrform
End If
    Flag = True
    Dim strSubject As String
Dim tempMsg As mailItem
If TypeName(Item) = "MailItem" Then
    Set tempMsg = FindParentMessage(Item)
End If
    Set m_Inspector = Application.ActiveInspector
    If TypeName(Item) = "MailItem" Then
        Set msg = GetCurrentItem()
    Else
        Exit Sub
    End If
    strDefaultStore = msg.Session.DefaultStore.DisplayName
    strSubject = msg.Subject
    NewSubject = strSubject
    If UCase(Left(NewSubject, 3)) = "RE:" Or UCase(Left(NewSubject, 3)) = "FW:" Then
        NewSubject = Trim(Replace(NewSubject, "RE:", ""))
        NewSubject = Trim(Replace(NewSubject, "FW:", ""))
    End If

    If InStr(1, strSubject, "Inbox_Job_Id:") <> 0 Then
        Dim LPosition As Integer
        LPosition = InStr(1, strSubject, "Inbox_Job_Id:")
        NewSubject = Trim(Left(NewSubject, LPosition - 2))
    End If
    esendrAc = msg.SendUsingAccount
    If esendrAc = "" Or esendrAc = strDefaultStore Then
        esendr = msg.SenderName
        If esendr = "" Then esendr = msg.SenderEmailAddress
    Else
        esendr = esendrAc
    End If
    On Error GoTo 0
   If strDefaultStore <> esendr And esendr <> "" Then
        If (EmailDetails.cmbresponsetype = "Acknowledged" Or EmailDetails.cmbresponsetype = "Follow-up" Or EmailDetails.cmbresponsetype = "In Progress") _
        And EmailDetails.txtfollowup = vbNullString Then
            MsgBox "Please enter Follow-up Date"
            EmailDetails.Show
            Cancel = True
        End If
       If IsNull(EmailDetails.cmblbl.Value) = True Or EmailDetails.cmblbl.Value = "" Or EmailDetails.cmbresponsetype.Value = "" _
        Or EmailDetails.cmbTask.Value = "" Then
            MsgBox "Please enter details in form to continue" & Chr(13) & "OR" & Chr(13) & "Please check vendor details"
            EmailDetails.Show
            EmailDetails.txtfollowup.Enabled = False
            EmailDetails.txtteamname = esendrAc
            EmailDetails.txtteamname.Locked = True
            EmailDetails.txtSub.Value = strSubject
            EmailDetails.txtdate.Value = Format(Now(), "DD-MMM-YYYY")
            EmailDetails.txttime.Value = Format(Now(), "HH:MM:SS")
            EmailDetails.txtuname.Value = Environ("Username")
            EmailDetails.txtfollowup.Value = EmailDetails.txtfollowup.Value
            EmailDetails.cmblbl.Value = EmailDetails.cmblbl.Value
            EmailDetails.cmbresponsetype.Value = EmailDetails.cmbresponsetype.Value
            EmailDetails.txtcomments.Value = EmailDetails.txtcomments.Value
           EmailDetails.cmbTask.Value = EmailDetails.cmbTask.Value
            Cancel = True
            Else
            Item.Save   

            Dim convid As String
            If tempMsg Is Nothing Then
                convid = msg.ConversationID
            Else
                convid = tempMsg.ConversationID
            End If

            Call modUpData.Upload(Item, convid)
            EmailDetails.Hide
            Application_Startup 
           
            Set olApp = Outlook.Application
            Set objNS = olApp.GetNamespace("MAPI")
           
            If UID <> "" Then Set msginbx = objNS.GetItemFromID(UID)
            Dim arr
            Dim i As Integer
            'If InStr(1, UCase(strSubject), UCase(USUB)) <> 0 And UID <> "" Then
            If InStr(1, UCase(msg.Subject), UCase(NewSubject)) <> 0 And UID <> "" Then
                arr = Split(msg.Categories, ",")
                If UBound(arr) >= 0 Then
                    For i = 0 To UBound(arr)
                      If Trim(arr(i)) = "No Action Required" Or Trim(arr(i)) = "Acknowledged" Or Trim(arr(i)) = "Resolved / Completed" Or Trim(arr(i)) = "In Progress" Or Trim(arr(i)) = "Follow-up" Then
                        ' remove it
                            arr(i) = ""
                            msg.Categories = Join(arr, ",")
                        End If
                        Next
                    End If
                   
                ' Category not found, add it
                msg.Categories = msginbx.Categories & "," & EmailDetails.cmbresponsetype.Value
                msg.Save
            Else
                    Set UItems = objNS.Folders(strDefaultStore).Folders("Inbox").Items
                    For Each UMail In UItems
                        'If InStr(1, UMail.Subject, Mid(strSubject, intStart, intSub)) <> 0 Then
                        If InStr(1, UCase(UMail.Subject), UCase(NewSubject)) <> 0 Then
                            arr = Split(UMail.Categories, ",")
                            If UBound(arr) >= 0 Then
                            ' Check for Category
                                For i = 0 To UBound(arr)
                                  If Trim(arr(i)) = "No Action Required" Or Trim(arr(i)) = "Acknowledged" Or Trim(arr(i)) = "Resolved / Completed" Or Trim(arr(i)) = "In Progress" Or Trim(arr(i)) = "Follow-up" Then
                                    ' remove it
                                        arr(i) = ""
                                        UMail.Categories = Join(arr, ",")
                                    End If
                                    Next
                                End If
                            ' Category not found, add it
    If EmailDetails.Grp1 = True Then
        grp = "Group One"
    ElseIf EmailDetails.Grp2 = True Then
        grp = "Group Two"
    ElseIf EmailDetails.Grp3 = True Then
        grp = "Group Three"
    End If
                            UMail.Categories = UMail.Categories & "," & EmailDetails.cmbresponsetype.Value & "-" & EmailDetails.cmblbl.Value & "-" & grp
                            UMail.Save
                            Exit For
                        End If
                Next UMail
            End If
        End If
    End If
End Sub
 

Iqbal Khan

New Member
Outlook version
Outlook 2013 64 bit
Email Account
POP3
I solved the issue, actually the categories were getting set for emails in Sent Items and not in the inbox. I removed the one which sets the category for current message and used .find to find the email I am replying with the subject and set the category to the email in Inbox.

Thank you
 

Similar threads

Top