Posts by lemonparty

    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