Hey Y'all I'm having a ton of trouble with this code, there's probably a better way to do it so I'm totally open to suggestions.
Basically I receive a multitude of emails in a day that have an attached message. Basically, people submit messages for me to review. I then categorize those emails based on whatever criteria and then do a bulk reply to those emails that have been categorized.
Essentially my question is this: Is there a way to automatically categorize an email based on who the sender is in the attached message?
I'll post my code below. My general idea was to categorize said contact, and then categorize each email based on the matched sender.
Sub Button4_Click()
Dim OLF As Outlook.MAPIFolder, oMAPI As Outlook.Namespace
Dim Mailbox As String, Folder As String
Dim findString As String
Dim extractLength As Integer
Dim OutlookApp As Outlook.Application
Dim OutlookItem As Object
Dim Email As Outlook.MailItem
Dim MsgEmail As Outlook.MailItem
Dim OutlookAttachment As Outlook.Attachment
Dim EmailAttachment As Outlook.MailItem
Dim MsgFileName As String
Mailbox = Sheets("Setting").Range("B1").Value
Folder = Sheets("Setting").Range("B2").Value
Set OutlookApp = GetObject(, "Outlook.Application")
If OutlookApp Is Nothing Then Set OutlookApp = New Outlook.Application
Set oMAPI = OutlookApp.GetNamespace("MAPI")
Set OLF = oMAPI.Folders.Item(Mailbox).Folders(Folder)
'Loop through items in folder
For Each OutlookItem In OLF.Items
'If this item is an email
If OutlookItem.Class = Outlook.OlObjectClass.olMail Then
'Search the email body text
Set Email = OutlookItem
'For each attachment in this email
For Each OutlookAttachment In Email.Attachments
'If this attachment is an email message (.msg)
If OutlookAttachment.Type = olEmbeddeditem And Right(OutlookAttachment.Filename, 4) = ".msg" Then
'Save it as a temporary file
MsgFileName = Environ("temp") & "" & Trim(OutlookAttachment.Filename)
OutlookAttachment.SaveAsFile MsgFileName
'Create a temporary in-memory email message from the file
Set MsgEmail = OutlookApp.CreateItemFromTemplate(MsgFileName)
'Apply category based on contact
Private Sub olItems_ItemAdd(ByVal Item As Object)
Dim oMail As MailItem
Dim olContacts As Outlook.Items
Dim obj As Object
Dim objVariant As Variant
Dim olCategory As String
Set olContacts = Outlook.Application.Session.GetDefaultFolder(olFolderContacts).Items
If TypeOf Item Is MailItem Then
Set oMail = Item
For Each obj In olContacts
If TypeOf obj Is ContactItem Then
Set objVariant = obj
If objVariant.Email1Address = oMail.SenderEmailAddress Then
olCategory = objVariant.Categories
oMail.Categories = olCategory
End If
End If
Next
End If
End Sub
'Delete the temporary email and file
MsgEmail.Delete
Set MsgEmail = Nothing
Kill MsgFileName
End If
Next
End If
Next
MsgBox "Completed", vbInformation
End Sub