Совет по отправке писем каждому студенту с помощью VBA
Я пытаюсь отправить каждому студенту электронные письма, содержащие (имя студента и его оценки), используя VBA ..
У меня есть лист Excel, как показано ниже
Сверху excel мне нужно отправить электронное письмо каждому студенту с основным текстом электронной почты, как показано ниже
Hi " Student name "
Below you can found your marks:-
Math :- " his mark"
Network :- "his mark"
Physics :- "his mark"
Antenna :- " his mark"
Я уже написал код в VBA, но я не знаю, как отправить такой текст каждому студенту в разделе mailBody..
Мой код, как показано ниже
Sub SendMail()
Dim objEmail
Const cdoSendUsingPort = 2 ' Send the message using SMTP
Const cdoBasicAuth = 1 ' Clear-text authentication
Const cdoTimeout = 100 ' Timeout for SMTP in seconds
mailServer = "smtp.gmail.com"
SMTPport = 465 '25 'SMTPport = 465
mailusername = Range("j9").Value
mailpassword = Range("j10").Value
''''''''
Dim n As Integer
n = Application.WorksheetFunction.CountA(Range("c:c")) - 1
For i = 1 To n
mailto = Range("c1").Offset(i, 0).Value
mailSubject = Range("e1").Offset(i, 0).Value
**mailBody = ??** What i should to set ?
Set objEmail = CreateObject("CDO.Message")
Set objConf = objEmail.Configuration
Set objFlds = objConf.Fields
With objFlds
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = cdoSendUsingPort
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = mailServer
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = SMTPport
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = cdoTimeout
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoBasicAuth
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = mailusername
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = mailpassword
.Update
End With
objEmail.To = mailto
objEmail.From = mailusername
objEmail.subject = mailSubject
objEmail.TextBody = mailBody
'objEmail.AddAttachment "C:\report.pdf"
objEmail.CC = Range("d1").Offset(i, 0).Value
objEmail.BCC = Range("k1").Offset(i, 0).Value
objEmail.Send
Set objFlds = Nothing
Set objConf = Nothing
Set objEmail = Nothing
Next i
End Sub
С уважением..
1 ответ
Решение
Попробуйте этот подход, пожалуйста:
mailBody = "Hy " & Range("B" & i) & "," & vbCrLf & vbCrLf & _
"Below you can find your marks:" & vbCrLf & vbCrLf & _
"Network: - " & Range("G" & i) & vbCrLf & _
"Physics: - " & Range("H" & i) & vbCrLf & _
"Antenna: - " & Range("I" & i)
И начнем итерацию с 2:
For i = 2 To n
Тогда не нужно никаких Offset
:
objEmail.CC = Range("d" & i).Value
objEmail.BCC = Range("k" & i).Value