Совет по отправке писем каждому студенту с помощью 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
Другие вопросы по тегам