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.
ExcelVoting.xlsx
MPDenverAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

NorieAnalyst Assistant Commented:
When does voting 'end'?
0
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
0
Neil FlemingConsultant and developerCommented:
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:
https://www.rondebruin.nl/win/s1/outlook/amail4.htm

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
            'ADD YOUR EMAIL ADDRESS HERE:
            .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)
            .Send
        End With
Set OutMail = Nothing
Set OutApp = Nothing
Me.tbLast = ""
Me.tbFirst = ""
Me.tbEmail = ""
MsgBox ("Results sent")
Me.Hide
End Sub

Function GetOutlook() As Object

On Error GoTo errortrap
'try to find open instance of outlook
Set GetOutlook = GetObject(, "Outlook.Application")
Exit Function
errortrap:
'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>"
    Next

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


End Function

Open in new window


Hope this does the trick.
Voting2.xlsm
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
MPDenverAuthor Commented:
Great work thank you !!
1
Neil FlemingConsultant and developerCommented:
My pleasure.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.