Excel Email Results

This worksheet captures the head to head results on the Legend Votes tab.  When it gets to the last vote it displays a message that the voting is complete.  

I would like to add the following please.

1 . At the end of the voting have a pop up window to capture the users name and email address.
2 . Email the results to a specific email address defined in the macro and CC the user the results from the
      captured email.
      Subjuect = Fullname from step 1 with Voting Results.  Example "John Doe Voting Results"
3. Clear the results on the spreadsheet to start a new vote.
Who is Participating?
Neil FlemingConnect With a Mentor Independent consultantCommented:
Try the attached. It assumes you are using Outlook. It opens a user form as requested, asks for name and email address, converts the voting range to an HTML table, creates an email, inserts it in the body of the email and sends it.

You need to set the destination email address in the code, obviously.

For more guidance on email from Excel, for instance if you want to email the whole file, see Ron de Bruin's famous site at:

Here are the key routines in the code in the user form I created. bSend_click sends the email. GetOutlook hooks into an open copy of Outlook, or opens it if it is not running. CheckMail just checks names and email address. Range2Table creates a simple HTML table from the votes.

The range rVotes2Send is defined in as a public variable in a separate code module mVote to make it accessible both to the worksheet and the user form.

Private Sub bSend_Click()

'check email address etc are well-formed
If Not checkMail Then Exit Sub

Set OutApp = GetOutlook
    Set OutMail = OutApp.CreateItem(0)

        With OutMail
            .bodyformat = 2
            .To = "mpdenver@somewhere.com"
            .CC = ""
            .BCC = ""
            .Subject = "Voting results: " & Me.tbFirst & " " & Me.tbLast
            'convert votes to html table and add to email
            .htmlbody = Range2Table(rVotes2Send)
        End With
Set OutMail = Nothing
Set OutApp = Nothing
Me.tbLast = ""
Me.tbFirst = ""
Me.tbEmail = ""
MsgBox ("Results sent")
End Sub

Function GetOutlook() As Object

On Error GoTo errortrap
'try to find open instance of outlook
Set GetOutlook = GetObject(, "Outlook.Application")
Exit Function
'create new instance if outlook is not open
Set GetOutlook = CreateObject("Outlook.Application")
End Function

Function checkMail() As Boolean
Dim i As Long, ss As String, sChar As String
Dim badEmail As Boolean
If Len(Me.tbLast) = 0 Then
MsgBox ("Please enter a last name")
Exit Function
End If

If Len(Me.tbFirst) = 0 Then
MsgBox ("Please enter a first name")
Exit Function
End If

If Len(Me.tbEmail) = 0 Then
MsgBox ("Please enter an email address name")
Exit Function
End If

If InStr(Me.tbEmail, " ") Then badEmail = True
If InStr(Me.tbEmail, "@") = 0 Then badEmail = True
If InStr(Me.tbEmail, ".") = 0 Then badEmail = True
If badEmail Then
MsgBox ("Email address does not look well-formed. Please check")
Exit Function
End If

checkMail = True

End Function

Function Range2Table(r As Range) As String
Dim iRow As Long, iCol As Long
Dim ss As String

If r Is Nothing Then Exit Function

ss = "<table>" & vbCrLf
For iRow = 1 To r.Rows.Count
ss = ss & "<tr>" & vbCrLf
    For iCol = 1 To r.Columns.Count
    ss = ss & "<td>" & r(iRow, iCol) & "</td>"

ss = ss & "</tr>" & vbCrLf
ss = ss & "</table>"
Range2Table = ss

End Function

Open in new window

Hope this does the trick.
NorieVBA ExpertCommented:
When does voting 'end'?
MPDenverAuthor Commented:
In the file you can see the code being used.  Here is part of the script that calls that out.  

I am okay collecting the Name, Email in the Voting Board and just using that vs a pop up.

'finished comparisons
    If iBlank = 2 Then
    MsgBox ("All comparisons complete")
    Exit Sub
    End If
MPDenverAuthor Commented:
Great work thank you !!
Neil FlemingIndependent consultantCommented:
My pleasure.
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.