This is a follow up to my post on sending email messages using Windows Vista. You can read the previous post here: http://www.msofficegurus.com/post/How-to-Windows-Vista-SMTP-Server-Using-CDOMessage.aspx

In this post, I discuss email validation using VBA. VBA email validation is a very simple process that does not require much, but you will need to install the Microsoft VBScript Regular Expressions 5.5.

In order to install the reference, follow these steps:

1. Open VBE (Alt+F11)
2. Go to “Tools --> References…”
3. Search in the reference list for Microsoft VBScript Regular Expressions 5.5, select it and click OK to continue.

The figure below shows the reference installed:


Figure 1: Microsoft VBScript Regular Expressions 5.5 reference installed

NOTE:
Only today, after receiving a comment on this post, I noticed that I was using Excel in Portuguese and not English. Since I am always changing the language settings, I sometimes forget to change back to the language I am writing on. I will leave the image as it is, as I am sure everyone can get the picture (if you will forgive me the pun). Added: July 3rd, 2009

Now, you can create a boolean user-defined function to test an email string to check whether it is a “regular expression”. In my case, I check for the following pattern:

\w+([-+.']\w+)*@\w+([-.]\w+)*\.\w+([-.]\w+)*

There are a number of patterns that you can you and you should be able to find my patterns, especially in sites that teach java or php (check RFC 2822 for info on pattern). You can then borrow one of those patterns and use in your code.

The user-defined function will look like this:

Function ValidateEmail(ByVal sEmail As String) As Boolean
 
    Dim oRegularExpression     As RegExp
 
'   Sets the regular expression object
    Set oRegularExpression = New RegExp

    With oRegularExpression
'   Sets the regular expression pattern
        .Pattern = "\w+([-+.']\w+)*@\w+([-.]\w+)*\.\w+([-.]\w+)*"
 
'   Ignores case
        .IgnoreCase = True

'       Test email string
        ValidateEmail = .Test(sEmail)
    End With
   
End Function

You can now test the user-defined function with a simple call:

Sub Test_ValidateEmail()
    MsgBox ValidateEmail("my.email@hotmail.com")
    MsgBox ValidateEmail("your.EMAIL@hotmail,com")
End Sub

Picture 1: Creating a new VSTO 2008 Excel Add-in project

With the projectcreated, we will add the following code to it:

Public Class ThisAddIn
    'Events tocontrol the commandbar button click event
    PrivateWithEvents oBtnHandleOrderTabs As Office.CommandBarButton
    PrivateWithEvents oBtnHandleCellDetails As Office.CommandBarButton

    'Commandbarcontrols used in the code
    PrivateoBtn As Office.CommandBarButton
    DimoCmdBarPopup As Office.CommandBar
    DimoEditCtl As Office.CommandBarControl

    'Stringsused in this code
    PrivateConst strconPOPUP_NAME AsString = "INFO_POPUP"
    PrivateConst strconBtn_POPUP_CAPTION As String = "ABOUT THE ACTIVE CELL"
    PrivateConst strconCmdBar_Cell_NAME As String = "Cell"
    PrivateConst strconCmdBar_Ply_NAME As String = "Ply"
    PrivateConst strconBtn_Ply_CAPTION As String = "Order Tabs"
    PrivateConst strconBtn_Cell_CAPTION As String = "View Cell Details"

    PrivateSub ThisAddIn_Startup(ByValsender As Object,_
                                  ByVal e AsSystem.EventArgs) Handles Me.Startup

        Try
            'Uponstarting up this Add-in, try:
            'Controlsare temporary; hence delete/reset is just a "fail-safe"
           Application.CommandBars(strconPOPUP_NAME).Delete()
           Application.CommandBars(strconCmdBar_Cell_NAME).Reset()
           Application.CommandBars(strconCmdBar_Ply_NAME).Reset()
        Catch ex As Exception
            'Catchexception and show to user
            MsgBox(ex.Message)
        EndTry
        'Callthe sub-routine to create menu items
        CallCreateMenu()
    End Sub

    PrivateSub ThisAddIn_Shutdown(ByValsender As Object,_
                                   ByVal e AsSystem.EventArgs) Handles Me.Shutdown
        'Nocode added here
    End Sub

    SubCreateMenu()
        'Author         : Robert Martim
        'Purpose        : Create menu items
        'Createdon     : 18 April 2009
        'Lastupdated   : 18 April 2009       

        'Add atemporary button to the Ply menu
        oBtn =Application.CommandBars(strconCmdBar_Ply_NAME) _
           .Controls.Add(Office.MsoControlType.msoControlButton, , , 1, True)

        'Definea few properties for the button
        WithoBtn
            .Caption =strconBtn_Ply_CAPTION

            .FaceId =210

            .Style =Office.MsoButtonStyle.msoButtonIconAndCaption
        EndWith

        'Setthe button so that its click event can be controlled
        oBtnHandleOrderTabs = oBtn

        'Add atemporary button to the Cell menu
        oBtn =Application.CommandBars(strconCmdBar_Cell_NAME) _
         .Controls.Add(Office.MsoControlType.msoControlButton, , , 1, True)

        'Definea few properties for the button
        WithoBtn
            .Caption =strconBtn_Cell_CAPTION
            .FaceId = 326
            .Style =Office.MsoButtonStyle.msoButtonIconAndCaption
        EndWith

        'Setthe button so that its click event can be controlled
        oBtnHandleCellDetails =oBtn

        '************************************************************
        'Adda popup menu to the commandbars collection
        oCmdBarPopup = Application.CommandBars.Add(_
          Name:=strconPOPUP_NAME,Position:=Office.MsoBarPosition.msoBarPopup)

        'Adda fixed button to work as a header label of the popup menu
        oBtn =oCmdBarPopup.Controls.Add( _
          Type:=Office.MsoControlType.msoControlButton)
        WithoBtn
            .Caption =strconBtn_POPUP_CAPTION
            .Width = 40
            .Enabled = False
        EndWith

        'Populatethe popup with 4 Edit controls
        ForI = 1 To 4
            oEditCtl = oCmdBarPopup.Controls.Add(_
             Type:=Office.MsoControlType.msoControlEdit)
            oEditCtl.Width = 200
        NextI

        'Setsome properties for the popup
        WithoCmdBarPopup
            .Width = 200
            .Protection =Microsoft.Office.Core.MsoBarProtection.msoBarNoChangeDock + _
             Microsoft.Office.Core.MsoBarProtection.msoBarNoCustomize + _
             Microsoft.Office.Core.MsoBarProtection.msoBarNoResize
        EndWith

    EndSub

    SubInfo()
        'Author         : Robert Martim
        'Purpose        : Sub to fill Edit control with celldetails
        'Createdon     : 18 April 2009
        'Lastupdated   : 18 April 2009  

        DimoActiveCell As Excel.Range

        Try
            'Try:
            'to fill Edit control with cell details
            oActiveCell =Application.ActiveCell
            WithApplication.CommandBars(strconPOPUP_NAME).Controls
                If oActiveCell.Formula = ""Then
                    .Item(2).Text= "This cell has no formula"
                ElseIf oActiveCell.Locked = TrueThen
                    .Item(2).Text= "Formula: " &oActiveCell.Formula
                End If
                .Item(3).Text = "Format: " & oActiveCell.NumberFormat
                .Item(4).Text = "Font name: " &oActiveCell.Font.Name
                .Item(5).Text = "Total of CFs on active cell: " & _
                   oActiveCell.FormatConditions.Count
            End With
        Catchex As Exception
            'Catch exception and show to user
            MsgBox(ex.Message)
        EndTry
        oActiveCell = Nothing
    EndSub


    SubOrderTabs()
        'Author         : Robert Martim
        'Purpose        : Order active workbook sheets
        'Createdon     : 18 April 2009
        'Lastupdated   : 18 April 2009  

        DimoWorkbook As Excel.Workbook
        DimiCount1 As Integer
        DimiCount2 As Integer

        Try
            oWorkbook =Application.ActiveWorkbook

            For iCount1 = 2 TooWorkbook.Sheets.Count Step 1
                For iCount2 = 1 ToiCount1 Step 1
                    If oWorkbook.Sheets(iCount2).Name >oWorkbook.Sheets(iCount1).Name Then
                       oWorkbook.Sheets(iCount1).Move(Before:=oWorkbook.Sheets(iCount2))
                    End If
                Next iCount2
            Next iCount1

        Catchex As Exception
            '     MsgBox(ex.Message)
        EndTry

        oWorkbook = Nothing

    End Sub

    Private SuboBtnHandleOrderTabs_Click(ByVal Ctrl As  _
                                         Microsoft.Office.Core.CommandBarButton, _
                                         ByRef CancelDefault As Boolean) _
                                         Handles oBtnHandleOrderTabs.Click
        'Author         : Robert Martim
        'Purpose        : Handles click event on the"Order Tabs" button
        'Createdon     : 18 April 2009
        'Lastupdated   : 18 April 2009 

        CallOrderTabs()
    End Sub

    PrivateSub oBtnHandleCellDetails_Click(ByVal Ctrl _
                                           AsMicrosoft.Office.Core.CommandBarButton, _
                                           ByRef CancelDefault As Boolean) _
                                           Handles oBtnHandleCellDetails.Click
        'Author         : Robert Martim
        'Purpose        : Handles click event on the "CellDetails" button
        'Createdon     : 18 April 2009
        'Lastupdated   : 18 April 2009  
        CallInfo()
       Application.CommandBars(strconPOPUP_NAME).ShowPopup()

    End Sub
End Class

Upon right-clicking on any Excel worksheet, the Ply popup menu will be shown,only this time it will have an extra Commandbar button added to it. You can nowclick on this Commandbar button to order the tabs alphabetically:
 

Picture 2: Order Tabs commandbar button

Picture 3: View Cell Details commandbar button
Finally, when we click onthis button our custom Commandbar popup is shown along with the cell’sinformation as viewed in the picture below: 
Picture 4: Cell Details commandbar popup menu

When you create a User-Defined function (UDF) you need to ensure that the function name is unique. If it conflicts with an internal name, then you will get an error. In this video, I show this scenario where a function named ALERT() is created and it conflicts with an Excel 4.0 macro function name. You will also learn how you can figure out these names as to avoid future problems.

 

This tip shows you how to use VBA to rename several files in a specific folder. The code was originally done in Excel but can be applied in any application of the Office Suite...

IN THE WORKBOOK ENTER THE CODE Private Sub Workbook_Open()     fileExtension = "jpg"     msg = "The files with extensions " & fileExtension _       & " in the folder " & ThisWorkbook.Path & " will be renamed."     msg = msg & " Are you sure you wish to continue?"     answer = MsgBox(msg, vbQuestion + vbYesNo)        If Not answer = vbYes Then Exit Sub     Call renameExtensions(fileExtension) End Sub   IN A MODULE ENTER THE CODE Sub renameExtensions(ByVal theExtension As String)    filePath = ThisWorkbook.Path       Set FsoObj = CreateObject("Scripting.FileSystemObject")       If FsoObj.FolderExists(filePath) = False Then: Exit Sub    i = 0    Set masterFolder = FsoObj.GetFolder(filePath)    For Each myFile In masterFolder.Files             If Not ThisWorkbook.FullName = myFile Then                 extExit = FsoObj.getextensionname(myFile)                                If UCase(theExtension) = UCase(extExit) Then                     FsoObj.MoveFile myFile, "C:\" & i & "." _                        & theExtension                     i = i + 1                 End If                            End If    Next    Set FsoObj = Nothing    If i <> 0 Then      MsgBox "The files in " & ThisWorkbook.Path & " were renamed."    Else:      MsgBox "No files were renamed as extension was not found."    End If End Sub

DOWNLOAD SAMPLE FILES HERE