IE Automation with VBA in Excel

2 October 2016

A bit of context: as well as being a super-hard-working maths student (...), I am a peer mentor for eight first-year students who have just started maths courses at the university. I am, in fact, a 'lead' peer mentor - generally speaking this doesn't entail much more work than the peer mentoring itself, but occasionally there is a little bit of work to be done around the management of the peer mentoring scheme within the department.

A little while ago, I was sent an email by the maths department's Director of Studies asking if I would mind helping to mix up and then divide the new intake of maths students between the 42 peer mentors. Attached to this email was a list of the names of the new students in an Excel spreadsheet.

Skipping forward to the point where I needed to let the other peer mentors know who they needed to contact, I decided that seeing as I had nothing else to be doing, I could save my fellow mentors a bit of time by finding the email addresses of the new students myself on the university computing system.

Four or five names in, however, I was already reassessing my benevolent decision - faced with another 320-odd names, and not willing to admit defeat, I decided to see if I could somehow automate the process.

Seeing as I was working in Excel, I came up with the idea of writing a VBA program that would:

  1. Open my webmail client
  2. Search for a person
  3. Copy their email address into the Excel spreadsheet, next to their name

A lot of experimentation and a lot of digging around in HTML source code later, a very rough-and-ready, very situation-specific, but nonetheless functional program did eventually emerge.

Here's the code:

Sub findemail()
 
' Launch an Internet Explorer window
Set IE = CreateObject("InternetExplorer.Application")
 
IE.Visible = True
 
' Navigate to webmail client
IE.Navigate "http://mail.bath.ac.uk/"
 
' Update Excel status bar
Application.StatusBar = "Bath mail client loading..."
 
' Wait for page to load
Do While IE.Busy
Application.Wait DateAdd("s", 1, Now)
Loop
 
' Add short delay to ensure all elements fully loaded
Application.Wait DateAdd("s", 2, Now)
 
' Update Excel status bar
Application.StatusBar = "Finding mentee..."
 
' Find "People" button on menu bar at top of webpage
Set topButtons = IE.document.getElementById("_ariaId_20")
 
topButtons.Click
 
' Wait for page to load
Do While IE.Busy
Application.Wait DateAdd("s", 1, Now)
Loop
 
' Add short delay to ensure all elements fully loaded
Application.Wait DateAdd("s", 2, Now)
 
' Find "Search people" box
Set searchbox = IE.document.getElementsByClassName("_n_o1 o365button " & _
"ms-font-m ms-border-color-themeLighter")
' Workaround to resolve issue occuring when trying to click single object
For Each obj In searchbox
obj.Click
Next
 
' Add short delay for loading
Application.Wait DateAdd("s", 1, Now)
 
' Input name from spreadsheet in "Forename Surname" format
SendKeys ActiveSheet.Range("G" & ActiveCell.Row).Value & " " & _
ActiveSheet.Range("F" & ActiveCell.Row).Value
 
' Wait to ensure name is pasted
Application.Wait DateAdd("s", 1, Now)
 
' Find search button
Set searchButton = _
IE.document.getElementsByClassName("_n_z searchImgWidth o365button ms-font-m")
 
' Workaround for single-object click issue mentioned earlier
For Each obj In searchButton
If obj.Type = "button" Then
obj.Click
End If
Next
 
' Update Excel status bar
Application.StatusBar = "Getting mentee email..."
 
' Give results time to load
Application.Wait DateAdd("s", 2, Now)
 
' Create list of all results from search
Set people = IE.document.getElementsByClassName("_pe_b _pe_s")
 
' There are 2 "invisible" non-result elements of the same class as the results,
' so a length-3 list means 1 person found
' If no people or multiple people found, give an error message (manual
' intervention needed later)
' Else find the person's email address on the page, and copy it into the
' spreadsheet
If people.Length <> 3 Then
 
ActiveCell.Value = "ERROR!"
 
Else
 
emailAddress = IE.document.getElementsByClassName("_rpc_41 ms-font-s " & _
"allowTextSelection _rpc_m1 ms-font-color-themePrimary " & _
"_rpc_p1").Item(0).innerText
 
ActiveCell.Value = emailAddress
 
End If
 
' Close IE window
IE.Quit
 
' Clear Excel status bar
Application.StatusBar = False
 
End Sub
 
'=============================================================================
 
Sub Go()
 
For Each cell In ActiveSheet.Range("J2:J326")
cell.Select
findemail
' Wait to ensure process has finished before moving on to next cell
Application.Wait DateAdd("s", 2, Now)
Next
 
End Sub
 
'=============================================================================
 
Sub GoFrom()
 
For Each cell In ActiveSheet.Range(ActiveCell, "J326")
cell.Select
findemail
' Wait to ensure process has finished before moving on to next cell
Application.Wait DateAdd("s", 2, Now)
Next
 
End Sub

And here's the program in action:

Writing the program, and running the whole list of names through it, probably took much longer than it would have done to find the email addresses manually; and certainly it would have been much easier to take the divide-and-conquer approach and ask the other mentors to find their own mentees' email addresses themselves. However, I did feel immensely proud of myself for rising to the challenge I had set myself, for creating a working program in a language I wasn't too familiar with and for helping out my fellow mentors.

The following day, I was sent an updated list of names by the department - with an extra column containing each student's email address.