VBA – Excel – Clear/Delete an Excel Worksheet

Have you ever needed to blank an Excel worksheet from an Access (or other programs as well – Word, PowerPoint, …) database? The following procedure does exactly that!

With this procedure, you can blank an entire WorkSheet or a specified Range on a WorkSheet.

'---------------------------------------------------------------------------------------
' Procedure : ClearXLSWrkSht
' Author    : CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Clear the specified worksheet in a given excel workbook from MS Access
' 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:
' ~~~~~~~~~~~~~~~~
' sXLSFile     Excel workbook filename with full path (ie: "C:\test.xls")
' sXLSWrkSht   Excel worksheet to be cleared (ie: "Sheet1")
'
' Usage Example:
' ~~~~~~~~~~~~~~~~
' ClearXLSWrkSht("C:\test.xls", "Sheet1") 'Clear Sheet1
' ClearXLSWrkSht("C:\test.xls", "Sheet1", "D7:H23") 'Clear range D7:H23 on Sheet1
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2010-Jan-28             Initial Release
' 2         2014-Jun-04             Added Ability to clear a specified Range rather than
'                                   the entire worksheet
'---------------------------------------------------------------------------------------
Sub ClearXLSWrkSht(sXLSFile As String, sXLSWrkSht As String, Optional sRng As String)
    On Error GoTo Error_Handler
    Dim xlApp           As Object
    Dim xlBook          As Object
    Dim xlSheet         As Object

    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = True    'Control whether or not Excel should be visible to
    'the user or not.
    Set xlBook = xlApp.Workbooks.Open(sXLSFile)  'Open the workbook
    Set xlSheet = xlBook.Worksheets(sXLSWrkSht)  'Worksheet we are working with

    If sRng = "" Then
'        xlSheet.Cells.Select
        xlSheet.Cells.ClearContents   'Clear the contents
    Else
'        xlSheet.Range(sRng).Select
        xlSheet.Range(sRng).ClearContents   'Clear the contents
    End If

    xlBook.Close True    'Close and save the workbook
    xlApp.Quit        'Close the instance of Excel we create

Error_Handler_Exit:
    On Error Resume Next
    Set xlSheet = Nothing
    Set xlBook = Nothing
    Set xlApp = Nothing
    Exit Sub

Error_Handler:
    MsgBox "The following error has occurred." & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: ClearXLSWrkSht" & vbCrLf & _
           "Error Description: " & Err.Description, _
           vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Sub

VBA – Excel – List the Sheet Names of an Excel Workbook

'---------------------------------------------------------------------------------------
' Procedure : ListXlsSheets
' Author    : CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : List the sheet name of an Excel Workbook
' 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:
' ~~~~~~~~~~~~~~~~
' sFile - The Excel file to list the sheets
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2008-Jul-15                 Initial Release
'---------------------------------------------------------------------------------------
Function ListXlsSheets(sFile As String)
On Error GoTo Error_Handler
    Dim NumSheets   As Integer
    Dim i           As Integer
    Dim xlApp       As Object
    Dim xlWrkBk     As Object
    Dim xlWrkSht    As Object
    
    On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application") 'Bind to existing instance of Excel
    
    If Err.Number <> 0 Then
        'Could not get instance of Excel, so create a new one
        Err.Clear
        On Error GoTo Error_Handler
        Set xlApp = CreateObject("excel.application")
    Else
        On Error GoTo Error_Handler
    End If

    xlApp.Visible = False 'make excel visible or not to the user
    Set xlWrkBk = xlApp.Workbooks.Open(sFile)
    
    NumSheets = xlWrkBk.Sheets.Count
    For i = 1 To NumSheets
        Debug.Print i & " - " & xlWrkBk.Sheets(i).Name
    Next i

    xlWrkBk.Close False
    xlApp.Close
    
    Set xlWrkSht = Nothing
    Set xlWrkBk = Nothing
    Set xlApp = Nothing
    
Exit Function

Error_Handler:
    If Err.Number <> 438 Then
        MsgBox "MS Access has generated the following error" & vbCrLf & vbCrLf & "Error Number: " & _
        Err.Number & vbCrLf & "Error Source: ListXlsSheets" & vbCrLf & "Error Description: " & _
        Err.Description, vbCritical, "An Error has Occurred!"
        Exit Function
    Else
        Resume Next
    End If

End Function

VBA – Excel – Print an Excel WorkSheet Range

'---------------------------------------------------------------------------------------
' Procedure : PrinWrkShtRng
' Author    : CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Print a specified worksheet range
' Copyright : It is not to be altered or distributed,
'             except as part of an application.
'             You are free to use it in any application,
'             provided the copyright notice is left unchanged.
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' strWrkBk      Workbook file name(full path and filename)
' strWrkSht     Worksheet name which whose range are to be printed
' strRng        Worksheet Range to be printed
'
'
' Revision History:
' Rev       Date(yyyy/mm)           Description
' **************************************************************************************
' 1         2008-Feb                Initial Release
'---------------------------------------------------------------------------------------
Function PrinWrkShtRng(strWrkBk As String, strWrkSht As String, strRng As String)
On Error GoTo PrinWrkShtRng_Error
    Dim xlApp       As Object
    Dim xlWrkBk     As Object
    Dim xlWrkSht    As Object

    On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application") 'Bind to existing instance of Excel
    
    If Err.Number <> 0 Then
        'Could not get instance of Excel, so create a new one
        Err.Clear
        On Error GoTo PrinWrkShtRng_Error
        Set xlApp = CreateObject("excel.application")
    Else
        On Error GoTo PrinWrkShtRng_Error
    End If

    xlApp.Visible = True 'make excel visible to the user
    Set xlWrkBk = xlApp.Workbooks.Open(strWrkBk)

    Set xlWrkSht = xlApp.Worksheets(strWrkSht)

    With xlWrkSht.PageSetup
        .PrintArea = strRng
        .Zoom = False
        .FitToPagesTall = 1
        .FitToPagesWide = 1
        .Orientation = xlLandscape
    End With

    xlWrkSht.PrintOut Copies:=1

    xlWrkBk.Close False
    xlApp.Close
    
    Set xlWrkSht = Nothing
    Set xlWrkBk = Nothing
    Set xlApp = Nothing
    
Exit Function

PrinWrkShtRng_Error:
    MsgBox "MS Access has generated the following error" & vbCrLf & vbCrLf & "Error Number: " & _
    Err.Number & vbCrLf & "Error Source: PrinWrkShtRng" & vbCrLf & _
    "Error Description: " & Err.Description, vbCritical, "An Error has Occurred!"
    Exit Function
    
End Function

VBA – Excel – Delete a Worksheet from a Workbook

'---------------------------------------------------------------------------------------
' Procedure : DelWrkSht
' Author    : CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Delete a worksheet from an Excel workbook
' Copyright : It is not to be altered or distributed,
'             except as part of an application.
'             You are free to use it in any application,
'             provided the copyright notice is left unchanged.
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' strWrkBk      Workbook to delete the worksheet in/from (full path and filename)
' strWrkSht     Worksheet to be deleted
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2008-Feb                 Initial Release
'---------------------------------------------------------------------------------------
Function DelWrkSht(strWrkBk As String, strWrkSht As String) As Boolean
    Dim xlApp       As Object
    Dim xlWrkBk     As Object

    On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application") 'Bind to existing instance of Excel
    
    If Err.Number <> 0 Then
        'Could not get instance of Excel, so create a new one
        Err.Clear
        On Error GoTo DelWrkSht_Error
        Set xlApp = CreateObject("excel.application")
    Else
        On Error GoTo DelWrkSht_Error
    End If

    Set xlWrkBk = xlApp.Workbooks.Open(strWrkBk)
    
        xlApp.DisplayAlerts = False 'suppress user confirmation prompt
        xlApp.Worksheets(strWrkSht).Delete
        xlApp.DisplayAlerts = True  're-enable user confirmation prompt
        xlApp.Visible = True
    
    Set xlApp = Nothing
    Set xlWrkBk = Nothing

    DelWrkSht = True

Exit Function

DelWrkSht_Error:
    DelWrkSht = False
    If Err.Number = 9 Then
        'Worksheet not found
        MsgBox "Worksheet '" & strWrkSht & "' not found in Workbook '" & strWrkBk & "'", vbCritical
        Exit Function
    ElseIf Err.Number = 1004 Then
        'Workbook not found
        MsgBox "Unable to locate Workbook '" & strWrkBk & "'", vbCritical
        Exit Function
    Else
        'Othere Errors
        MsgBox "MS Access has generated the following error" & vbCrLf & vbCrLf & "Error Number: " & _
        Err.Number & vbCrLf & "Error Source: DelWrkSht" & vbCrLf & _
        "Error Description: " & Err.Description, vbCritical, "An Error has Occurred!"
        Exit Function
    End If
End Function

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.

'---------------------------------------------------------------------------------------
' Procedure : AddOlContact
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Create a new Contact item in Outlook
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
'             (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: Uses Late Binding, so none required
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' None, I need to convert this into a proper function, but for right now I leave that
' to you.  This is a great starting point.
'
' Usage:
' ~~~~~~
' Call AddOlContact
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         Unknown                 Initial Release
' 2         2010-09-03              Website Release
' 3         2018-08-28              Added Early/Late Binding Option
'                                   Updated Error Handling Slightly
'                                   Added Picture demonstration
'                                   Updated Copyright
'---------------------------------------------------------------------------------------
Public Sub AddOlContact()
    'Ref: https://docs.microsoft.com/en-us/office/vba/api/outlook.contactitem
    On Error GoTo Error_Handler
    #Const EarlyBind = False    'True  = Use Early Binding
                                'False = Use Late Binding
    #If EarlyBind = True Then
        'Early Binding Declarations
        'Requires Ref to Microsoft Outlook XX.X Object Library
        Dim oOutlook          As Outlook.Application
        Dim olContact         As Outlook.ContactItem
    #Else
        'Late Binding Declaration/Constants
        Dim olApp             As Object
        Dim olContact         As Object
        Const olContactItem = 2
    #End If

    Set olApp = CreateObject("Outlook.Application")
    Set olContact = olApp.CreateItem(olContactItem)

    With olContact
        .FirstName = "Daniel"
        .LastName = "Alba"
        .FullName = "Alba, Daniel"
        .FileAs = "D. Alba"
        .Anniversary = #7/22/1975#
        .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 = ""
        .AddPicture ("C:\Users\ItsMe\Pictures\home-2955065_960_720.jpg")
        .Save    
        '.Display 'Uncomment if you wish the user to see the contact pop-up
    End With

Error_Handler_Exit:
    On Error Resume Next
    If Not olContact Is Nothing Then Set olContact = Nothing
    If Not olApp Is Nothing Then Set olApp = Nothing
    Exit Function

Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: AddOlContact" & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Function

Update

Things have changed since the article was first published. If you are experiencing issues with the CreateObject(… line, then see my post entitled: CreateObject(“Outlook.Application”) Does Not Work, Now What?

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 occurred" & vbCrLf & vbCrLf & "Error Number: " & _
    Err.Number & vbCrLf & "Error Source: AddOlkTask" & vbCrLf & "Error Description: " & _
    Err.Description, vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Function

Update

VBA – Send HTML Emails Using 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 sBody 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:

Continue reading →

VBA – Send Emails Using 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)
              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

Update

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 e-mail. 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 weigh this carefully when considering implementing any of the following workarounds.

Outlook Redemption

This solution is often mentioned in numerous Forums. For more information refer to http://www.dimastr.com/redemption/home.htm

vbMAPI

Another alternative is vbMAPI which you can review at https://www.everythingaccess.com/vbmapi.asp. I have no personal experience with this product, but it has been highly recommended to me by multiple very reliable source.

CDO

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

http://www.devhut.net/2014/11/29/vba-cdo-mail/

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.

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 launching 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.

https://web.archive.org/web/20061218070602/http://msdn2.microsoft.com/en-us/library/aa159619(office.11).aspx (Web Archive version as Microsoft has removed the original page)