VBA Code

NewMail Event
Occurs when one or more new e-mail messages are received in the Inbox.


The NewMail event is useful for scenarios in which you want to be notified when a new e-mail message arrives.
If you want to process items that arrive in the Inbox, consider using the ItemAdd event on the collection of items in the Inbox.
The ItemAdd event passes a reference to each item that is added to a folder.



This Microsoft Visual Basic/Visual Basic for Applications (VBA) example displays the Inbox folder when a new e-mail message arrives.
The sample code must be placed in a class module, and the Initialize_handler routine must be called before the event procedure can be called by Microsoft Outlook.


Public WithEvents myOlApp As Outlook.Application 

Sub Initialize_handler()
    Set myOlApp = CreateObject("Outlook.Application")
End Sub

Private Sub myOlApp_NewMail()
    Dim myExplorers As Outlook.Explorers
    Dim myFolder As Outlook.MAPIFolder
    Dim x As Integer
    Set myExplorers = myOlApp.Explorers
    Set myFolder = myOlApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
    If myExplorers.Count <> 0 Then
        For x = 1 To myExplorers.Count
            On Error GoTo skipif
            If myExplorers.Item(x).CurrentFolder.Name = "Inbox" Then
                myExplorers.Item(x).Display
                myExplorers.Item(x).Activate
                Exit Sub
            End If
skipif:
        Next x
     End If
     On Error GoTo 0
     myFolder.Display
End Sub

Public Sub Outlook_SendEmail() '(ByVal iValue As Integer)

Dim objApplication As Outlook.Application
Dim objMailItem As Outlook.MailItem
Dim objAttachments As Outlook.Attachments
Dim objAttachment As Outlook.Attachment
Dim sMessageEntryID As String

Dim objMAPISession As MAPI.Session
Dim objMAPIMessage As MAPI.Message
Dim objMAPIAttachments As MAPI.Attachments
Dim objMAPIAttachment As MAPI.Attachment
Dim objFields As MAPI.Fields
Dim objField As MAPI.Field

   On Error GoTo ErrorHandler
   Set objApplication = Outlook.ApplicationReturn
   Set objMailItem = objApplication.CreateItem(olMailItem)
   
   objMailItem.Subject = "the title"
   objMailItem.To = "me@that.com"
   
'embedding the graphic
   Set objAttachments = objMailItem.Attachments
   Set objAttachment = objAttachments.Add("C:\temp\file1.gif")
   Set objAttachment = objAttachments.Add("C:\temp\file2.gif")
   objMailItem.Close olSave
   
   sMessageEntryID = objMailItem.EntryID
   
'you must dereference the objects before changing their properties
   Set objMailItem = Nothing
   Set objAttachments = Nothing
   Set objAttachment = Nothing
   
   Set objMAPISession = CreateObject("MAPI.Session")
   objMAPISession.Logon "", "", False, False

   Set objMAPIMessage = objMAPISession.GetMessage(sMessageEntryID)
   Set objMAPIAttachments = objMAPIMessage.Attachments
   
   Set objMAPIAttachment = objMAPIAttachments.Item(1)
   Set objFields = objMAPIAttachment.Fields
   Set objField = objFields.Add(CdoPR_ATTACH_MIME_TAG, "image/jpeg")
   Set objField = objFields.Add(&H3712001E, "file1")
   objMAPIMessage.Fields.Add "{ unique GUID } ox8514", 11, True
   objMAPIMessage.Update

   Set objMAPIAttachment = objMAPIAttachments.Item(2)
   Set objFields = objMAPIAttachment.Fields
   Set objField = objFields.Add(CdoPR_ATTACH_MIME_TAG, "image/jpeg")
   Set objField = objFields.Add(&H3712001E, "file2")
   objMAPIMessage.Fields.Add "{ unique GUID } ox8514", 11, True
   objMAPIMessage.Update
   
   Set objMailItem = objApplication.GetNamespace("MAPI").GetItemFromID(sMessageEntryID)
   
   objMailItem.HTMLBody = Outlook_EmailBodyText(20)
   objMailItem.Display

   Exit Sub
ErrorHandler:
   Call MsgBox(Err.Number & " - " & Err.Description, , "Outlook_SendEmail")
End Sub
'****************************************************************************************
Public Function Outlook_EmailBodyText(ByVal iValue As Integer) As String
Dim sText As String
   
   sText = ""
   sText = "this is some text" & "<BR>"
   sText = "<img src=cid:file1>"
   sText = "<img src=cid:file2>"
   sText = "<BR>"
   
   Outlook_EmailBodyText = sText
End Function



© 2025 Better Solutions Limited. All Rights Reserved. © 2025 Better Solutions Limited TopPrev