Archive for ‘MS Access – Outlook Automation’

September 3rd, 2010

VBA – Create an Outlook Contact

The following procedure illustrates how easily one can use VBA to create an Outlook Contact using Late binding so no references are required. Also note, there are many more contact properties available to the VBA programmer, for a full list consult the Outlook Help file.

Function AddOlContact()
On Error GoTo Error_Handler
    Const olContactItem = 2
    Dim olApp As Object
    Dim Ctct As Object
 
    Set olApp = CreateObject("Outlook.Application")
    Set olContact = olApp.CreateItem(olContactItem)
 
    With olContact
        .FirstName = "Daniel"
        .LastName = "Alba"
        .JobTitle = ""
        .CompanyName = "MINI CARDA"
        .BusinessAddressStreet = "22 ClearPoint"
        .BusinessAddressCity = "Pointe-Claire"
        .BusinessAddressState = "Quebec"
        .BusinessAddressCountry = "Canada"
        .BusinessAddressPostalCode = "H9X 3A6"
        .BusinessTelephoneNumber = "(514) 488-0956"
        .BusinessFaxNumber = ""
        .Email1Address = "mini@mini.com"
        .MobileTelephoneNumber = ""
        .Save 'use .Display if you wish the user to see the contact pop-up
    End With
 
Error_Handler_Exit:
    On Error Resume Next
    Set olContact = Nothing
    Set olApp = Nothing
    Exit Function
 
Error_Handler:
    MsgBox "MS Access has generated the following error" & vbCrLf & vbCrLf & "Error Number: " & _
    Err.Number & vbCrLf & "Error Source: AddOlContact" & vbCrLf & "Error Description: " & _
    Err.Description, vbCritical, "An Error has Occured!"
    Resume Error_Handler_Exit
End Function

CategoryMS Access - Outlook Automation | Comment3 Comments »

September 3rd, 2010

VBA – Create an Outlook Task

Below is a simple function which permits you to use VBA to add a task into Outlook using late binding, so no references are required!

'---------------------------------------------------------------------------------------
' Procedure : AddOlTask
' Author    : CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Create a task in Outlook using late binding (no need for references)
' Copyright : The following may be altered and reused as you wish so long as the
'             copyright notice is left unchanged (including Author, Website and
'             Copyright).  It may not be sold/resold or reposted on other sites (links
'             back to this site are allowed).
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sSubject          : Task subject
' sBody             : Task body (the actual content message in the task)
' dtDueDate         : Task due date
' dtReminderDate    : Task reminder date/time
'
' Usage Example:
' ~~~~~~~~~~~~~~~~
' ? AddOlTask("Meeting with Daniel","Meeting w/ Daniel to discuss the database.", _
'             #5/31/2010#, #5/29/2010 9:00 AM#)
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2010-May-20                 Initial Release
'---------------------------------------------------------------------------------------
Function AddOlTask(sSubject As String, sBody As String, _
                    dtDueDate As Date, _
                    dtReminderDate As Date)
On Error GoTo Error_Handler
 
    Const olTaskItem = 3
    Dim OlApp As Object
    Dim OlTask As Object
 
    Set OlApp = CreateObject("Outlook.Application")
    Set OlTask = OlApp.CreateItem(olTaskItem)
 
    With OlTask
        .Subject = sSubject
        .DueDate = dtDueDate
        .Status = 1                 '0=not started, 1=in progress, 2=complete, 3=waiting,
                                    '4=deferred
        .Importance = 1             '0=low, 1=normal, 2=high
        .ReminderSet = True
        .ReminderTime = dtReminderDate
        .Categories = "Business" 'use any of the predefined Categorys or create your own
        .Body = sBody
        .Save   'use .Display if you wish the user to see the task form and make
                'them perform the save
    End With
 
Error_Handler_Exit:
    On Error Resume Next
    Set OlTask = Nothing
    Set OlApp = Nothing
    Exit Function
 
Error_Handler:
    MsgBox "The following error has occured" & vbCrLf & vbCrLf & "Error Number: " & _
    Err.Number & vbCrLf & "Error Source: AddOlkTask" & vbCrLf & "Error Description: " & _
    Err.Description, vbCritical, "An Error has Occured!"
    Resume Error_Handler_Exit
End Function

CategoryMS Access - Outlook Automation | CommentNo Comments »

September 3rd, 2010

VBA – HTML Outlook Automation

Creating HTML Emails From Access using VBAVery similarily to the VBA Outlook Automation procedure, one need only make a slight modification.

Simply replace the line:

.Body = strBody

with

.HTMLBody = strBody

In which case, the strBody must now be in HTML format “Your content goes here” . Do not forget the HTML and BODY tags. The .HTMLBody can use most basic HTML Tags so go wild creating your messages (<i></i>, <b></b>, <br />, <p>, <h1>,…, <h6>, <a href>…, <img>, <src>…., ..)

So our new HTML Email procedure would be:

'---------------------------------------------------------------------------------------
' Procedure : SendHTMLEmail
' Author    : CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Automate Outlook to send an HTML email with or without attachments
' Copyright : The following may be altered and reused as you wish so long as the
'             copyright notice is left unchanged (including Author, Website and
'             Copyright).  It may not be sold/resold or reposted on other sites (links
'             back to this site are allowed).
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' strTo         To Recipient email address string (semi-colon separated list)
' strSubject    Text string (HTML) to be used as the email subject line
' strBody       Text string to be used as the email body (actual message)
' bEdit         True/False whether or not you wish to preview the email before sending
' strBCC        BCC Recipient email address string (semi-colon separated list)
' AttachmentPath    single value or array of attachment (complete file paths with
'                   filename and extensions)
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2007-Nov-16             Initial Release
'---------------------------------------------------------------------------------------
Function SendHTMLEmail(strTo As String, strSubject As String, strBody As String, bEdit As Boolean, _
                   Optional strBCC As Variant, Optional AttachmentPath As Variant)
'Send Email using late binding to avoid reference issues
   Dim objOutlook As Object
   Dim objOutlookMsg As Object
   Dim objOutlookRecip As Object
   Dim objOutlookAttach As Object
   Dim i As Integer
   Const olMailItem = 0
 
   On Error GoTo ErrorMsgs
 
   Set objOutlook = CreateObject("Outlook.Application")
 
   Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
   With objOutlookMsg
      Set objOutlookRecip = .Recipients.Add(strTo)
      objOutlookRecip.Type = 1
 
      If Not IsMissing(strBCC) Then
        Set objOutlookRecip = .Recipients.Add(strBCC)
        objOutlookRecip.Type = 3
      End If
 
      .Subject = strSubject
      .HTMLBody = strBody
      .Importance = 2  'Importance Level  0=Low,1=Normal,2=High
      
      ' Add attachments to the message.
      If Not IsMissing(AttachmentPath) Then
        If IsArray(AttachmentPath) Then
           For i = LBound(AttachmentPath) To UBound(AttachmentPath) - 1
              If AttachmentPath(i) <> "" And AttachmentPath(i) <> "False" Then
                Set objOutlookAttach = .Attachments.Add(AttachmentPath(i))
              End If
           Next i
        Else
            If AttachmentPath <> "" And AttachmentPath(i) <> "False" Then
                Set objOutlookAttach = .Attachments.Add(AttachmentPath)
            End If
        End If
      End If
 
      For Each objOutlookRecip In .Recipients
         If Not objOutlookRecip.Resolve Then
            objOutlookMsg.Display
         End If
      Next
 
      If bEdit Then 'Choose btw transparent/silent send and preview send
        .Display
      Else
        .Send
      End If
   End With
 
   Set objOutlookMsg = Nothing
   Set objOutlook = Nothing
   Set objOutlookRecip = Nothing
   Set objOutlookAttach = Nothing
 
ErrorMsgs:
   If Err.Number = "287" Then
      MsgBox "You clicked No to the Outlook security warning. " & _
      "Rerun the procedure and click Yes to access e-mail " & _
      "addresses to send your message. For more information, " & _
      "see the document at http://www.microsoft.com/office" & _
      "/previous/outlook/downloads/security.asp."
      Exit Function
   ElseIf Err.Number <> 0 Then
      MsgBox Err.Number & " - " & Err.Description
      Exit Function
   End If
End Function

CategoryMS Access - Outlook Automation | CommentNo Comments »

September 3rd, 2010

VBA – Outlook Automation

---------------------------------------------------------------------------------------
' Procedure : SendEmail
' Author    : CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Automate Outlook to send emails with or without attachments
' Copyright : The following may be altered and reused as you wish so long as the
'             copyright notice is left unchanged (including Author, Website and
'             Copyright).  It may not be sold/resold or reposted on other sites (links
'             back to this site are allowed).
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' strTo         To Recipient email address string (semi-colon separated list)
' strSubject    Text string to be used as the email subject line
' strBody       Text string to be used as the email body (actual message)
' bEdit         True/False whether or not you wish to preview the email before sending
' strBCC        BCC Recipient email address string (semi-colon separated list)
' AttachmentPath    single value or array of attachment (complete file paths with
'                   filename and extensions)
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2007-Nov-16             Initial Release
'---------------------------------------------------------------------------------------
Function SendEmail(strTo As String, strSubject As String, strBody As String, bEdit As Boolean, _
                   Optional strBCC As Variant, Optional AttachmentPath As Variant)
'Send Email using late binding to avoid reference issues
   Dim objOutlook As Object
   Dim objOutlookMsg As Object
   Dim objOutlookRecip As Object
   Dim objOutlookAttach As Object
   Dim i As Integer
   Const olMailItem = 0
 
   On Error GoTo ErrorMsgs
 
   Set objOutlook = CreateObject("Outlook.Application")
 
   Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
   With objOutlookMsg
      Set objOutlookRecip = .Recipients.Add(strTo)
      objOutlookRecip.Type = 1
 
      If Not IsMissing(strBCC) Then
        Set objOutlookRecip = .Recipients.Add(strBCC)
        objOutlookRecip.Type = 3
      End If
 
      .Subject = strSubject
      .Body = strBody
      .Importance = 2  'Importance Level  0=Low,1=Normal,2=High
      
      ' Add attachments to the message.
      If Not IsMissing(AttachmentPath) Then
        If IsArray(AttachmentPath) Then
           For i = LBound(AttachmentPath) To UBound(AttachmentPath) - 1
              If AttachmentPath(i) <> "" And AttachmentPath(i) <> "False" Then
                Set objOutlookAttach = .Attachments.Add(AttachmentPath(i))
              End If
           Next i
        Else
            If AttachmentPath <> "" Then
                Set objOutlookAttach = .Attachments.Add(AttachmentPath)
            End If
        End If
      End If
 
      For Each objOutlookRecip In .Recipients
         If Not objOutlookRecip.Resolve Then
            objOutlookMsg.Display
         End If
      Next
 
      If bEdit Then 'Choose btw transparent/silent send and preview send
        .Display
      Else
        .Send
      End If
   End With
 
   Set objOutlookMsg = Nothing
   Set objOutlook = Nothing
   Set objOutlookRecip = Nothing
   Set objOutlookAttach = Nothing
 
ErrorMsgs:
   If Err.Number = "287" Then
      MsgBox "You clicked No to the Outlook security warning. " & _
      "Rerun the procedure and click Yes to access e-mail " & _
      "addresses to send your message. For more information, " & _
      "see the document at http://www.microsoft.com/office" & _
      "/previous/outlook/downloads/security.asp."
      Exit Function
   ElseIf Err.Number <> 0 Then
      MsgBox Err.Number & " - " & Err.Description
      Exit Function
   End If
End Function

CategoryMS Access - Outlook Automation | CommentNo Comments »

September 3rd, 2010

Outlook Automation – Bypass Outlook’s Security Prompt

Once you finally get your Outlook automation up and running you will notice that your users receive a security prompt each time your database attempts to send an automated email. Obviously, as a programmer this is not the ideal situation and there are a couple of options available to you.

 

What you need to know before going any further:

The security prompt appears for a reason. MS added this prompt to try and stop malicious usage of peoples email without their knowledge and/or consent. Many virii were propagating themselves through peoples email. This type of added security will hinder this type of attack. As a developper you must way this carefully when considering implementing any of the following work arounds.

 

Redemtion

This solution is often mentioned in numerous Forums. For more information refer to http://www.slipstick.com/outlook/esecup.htm, specifically ‘Outlook Redemption’ which is located in the ‘Automation Security’ section.

 

CDO

Another commonly refered to solution found in numerous Discussion Forums. The following website provides several example of programming with CDO.

http://www.paulsadowski.com/WSH/cdo.htm

 

Thrid Party Emailing Utilities

In my past life, when I was working for a multinational company, the work around that I implemented was to use BLAT to send the emails. I used VBA to produce a text file based on this information from within the database and it in turn was utilized by BLAT to send the email. It worked seemlessly! Best of all it is free.

 

VBScript?

Someone once mentioned that they could send emails using VBScripts without getting the security prompt. This said, I have never validated this yet.

 

Third Party Application to Automate the Confirmation

There are several little utilities available online that you can install on your clients computers that will simply automatically Click the Yes button to authorize that the email be sent. One of these programs is ClickYes. This however, bypasses security completely and could be considered a serious security issue.

CategoryMS Access - Outlook Automation | CommentNo Comments »

September 3rd, 2010

VBA – Automating Outlook

Automating Outlook from Access has become a more and more requested feature. The link provided below is the best source of information on this subject with complete code examples. However, before lauching into automating Outlook to send emails from Access make sure that the DoCmd.SendObject method does not suffice your needs as it is much simpler to code.

http://msdn2.microsoft.com/en-us/library/aa159619(office.11).aspx

CategoryMS Access - Outlook Automation | CommentNo Comments »