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