Do the following:
1. Before we get start, you need to add a reference to the CDO Library.
To do this use the Tools->References menu in the VBA-Editor
The full name of the library we are going to use is Microsoft CDO for Windows 2000.
2. Allow less secure apps to access your Gmail account
myaccount.google.com
3. You did not indicate where to get the student's email account. In the macro I put an example for you to perform tests
4. Change "
myEmail@gmail.com" and "myPassword" , for your data to send emails from Gmail.
5. Run this code:
VBA Code:
Sub Send_Gmail_to_students()
Dim EmailMsg, EmailConf As Object, EmailFields As Variant
Dim sh As Worksheet, Mess As String, Email As String
Dim j As Long, EmailUsr As String, EmailPwd
'
EmailUsr = "myEmail@gmail.com"
EmailPwd = "myPassword"
Set sh = ActiveSheet
For j = 2 To sh.Cells(1, Columns.Count).End(xlToLeft).Column
Set EmailMsg = CreateObject("CDO.Message") 'CDO (Collaboration Data Objects) -Make sure you have the 'CDO For Windows' Library Selected
Set EmailConf = CreateObject("CDO.Configuration")
EmailConf.Load -1 ' Set CDO Source Defaults
Set EmailFields = EmailConf.Fields
With EmailFields
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = EmailUsr
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = EmailPwd
.Update
End With
Email = "student_1@yahoo.com"
Mess = "<b>" & sh.Range("A1").Value & " " & sh.Cells(1, j).Value & "</b><br>" & _
sh.Range("A2").Value & " " & sh.Cells(2, j).Value & "<br>" & _
sh.Range("A3").Value & " " & sh.Cells(3, j).Value & "<br>" & _
sh.Range("A4").Value & " " & sh.Cells(4, j).Value & "<br>" & _
"<b>" & sh.Range("A5").Value & " " & sh.Cells(5, j).Value & "</b>"
With EmailMsg
Set .Configuration = EmailConf
.To = Email
.CC = ""
.From = EmailUsr
.Subject = "Set of grades"
.htmlBody = Mess
On Error Resume Next
.Send
On Error GoTo 0
End With
If Err.Number = 0 Then
Else
MsgBox Err.Number & " " & Err.Description
End If
'Cleanup
Set EmailMsg = Nothing
Set EmailConf = Nothing
Set EmailFields = Nothing
Next
End Sub
