Source code for Issue Number 113

Copyright 1997-2000 by C&D Programming Corp. All Rights Reserved. Source code may not be reproduced except for use in a compiled executable. All rights reserved. If you would like to reprint any or all of this code please email us at info@codeoftheweek.com

Code of the Week Home


Source Code

Create a new class module and paste this source code into it. Change the name of the module to cOutlookIntegration. If you have any questions, email us at help@codeoftheweek.com

Option Explicit

'----------------------------------------------------------------------
'
'   Module Name:    cOutlookIntegration
'   Written By:     C&D Programming Corp.
'   Create Date:    11/99
'   Copyright:      Copyright 1999 by C&D Programming Corp.  Source
'                   code may not be reproduced except for use in a
'                   compiled executable.  All rights reserved.  If
'                   you would like to reprint any or all of this
'                   code please email us at info@codeoftheweek.com
'----------------------------------------------------------------------

Private molApp As Outlook.Application
Private molMessage As Outlook.MailItem

Public Sub ComposeMessage(Optional olItem As OlItemType = olMailItem)
    If molApp Is Nothing Then
        Set molApp = New Outlook.Application
    End If
    Set molMessage = molApp.CreateItem(olItem)
End Sub

Public Sub AddRecipient(sRecipient As String, Optional eRecipientType As OlMailRecipientType = olTo)
    Dim oRecip As Recipient
    If molMessage Is Nothing Then
        ComposeMessage
        ' if you do not want it to automatically compose a message, uncomment below line
        ' and remove above line
        'Err.Raise 5, "AddRecipient", "You must call ComposeMessage first."
    End If
    Set oRecip = molMessage.Recipients.Add(sRecipient)
    ' olBCC(3), olCC(2), olOriginator(0), or olTo(1)
    oRecip.Type = eRecipientType
End Sub

Public Property Let ImportanceFlag(eImportance As OlImportance)
    If molMessage Is Nothing Then
        ComposeMessage
        ' if you do not want it to automatically compose a message, uncomment below line
        ' and remove above line
        'Err.Raise 5, "ImportanceFlag", "You must call ComposeMessage first."
    End If
    molMessage.Importance = eImportance
End Property

Public Property Let Subject(sSubject As String)
    If molMessage Is Nothing Then
        ComposeMessage
        ' if you do not want it to automatically compose a message, uncomment below line
        ' and remove above line
        'Err.Raise 5, "Subject", "You must call ComposeMessage first."
    End If
    molMessage.Subject = sSubject
End Property

Public Property Let MessageBody(sBody As String)
    If molMessage Is Nothing Then
        ComposeMessage
        ' if you do not want it to automatically compose a message, uncomment below line
        ' and remove above line
        'Err.Raise 5, "MessageBody", "You must call ComposeMessage first."
    End If
    molMessage.Body = sBody
End Property

Public Sub SendMessage()
    If molMessage Is Nothing Then
        Err.Raise 5, "SendMessage", "You must call ComposeMessage and then AddRecipient before sending the message."
    End If
    molMessage.Send
End Sub
'
'   sFilename should contain the full file and path name to the attachment
'
'
Public Sub AddAttachment(sFilename As String, sDescription As String)
    Dim oAttachments As Outlook.Attachments

    Set oAttachments = molMessage.Attachments
    ' puts a blank line at the end of the message and adds the attachment
    ' this is one way of handling the attachment.  You might want to give it
    ' an option to put the attachments at the beginning or the middle of the message.
    molMessage.Body = molMessage.Body & vbCrLf & " " ' position for attachment
    oAttachments.Add sFilename, olByValue, Len(molMessage.Body), sDescription
End Sub