Совет по арабским символам с использованием VBA

Я работаю над отправкой писем каждому студенту, содержащему (имя студента и его оценки) из таблицы Excel, как показано ниже.

Все работает нормально, но когда имя студента арабскими буквами. имя отображается как (????), как вы можете видеть ниже

Я изменил настройку локальной системы на арабский, но все равно получил ту же проблему.

Любой совет?

Источник

2 ответа

Решение

Вам нужно установить htmlBody и используйте набор символов utf-8.

Используйте следующую функцию для простого преобразования текстовой строки в строку html.

Function StringToHTML(sStr As String) As String
    sStr = Replace(sStr, Chr(10), "<br/>")
    sStr = Replace(sStr, Chr(13), "<br/>")
    sStr = Replace(sStr, Chr(11), "<br/>")
    StringToHTML = "<!doctype html><html lang=""en""><body><p>"
    StringToHTML = StringToHTML & sStr
    StringToHTML = StringToHTML & "</p></body></html>"
End Function

В связи с этим необходимо заменить строкуobjEmail.TextBody = mailBody со следующими двумя строками

objEmail.htmlBody = StringToHTML(mailBody)
objEmail.HtmlBodyPart.Charset = "utf-8"

Если у вас возникнут дополнительные проблемы (например, тема электронного письма содержит арабские символы, но не отображается должным образом), попробуйте добавить эти две строки.

objEmail.TextBodyPart.Charset = "utf-8"
objEmail.BodyPart.Charset = "utf-8"

Изменить (следующий комментарий)

Ваш полный код должен быть таким

Sub SendMail()
    Dim objEmail
    Dim mailBody as String

    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 = "email@some.com"
     mailpassword = "password"
     ''''''''
     
     Dim n As Integer
     n = Application.WorksheetFunction.CountA(Range("c:c"))
     For i = 2 To n
     
     mailto = Range("c" & i).Value
     mailSubject = Range("e" & i).Value
     mailBody = "Hi " & Range("b" & i) & "," & vbCrLf & vbCrLf & _
               "Below you can find your marks:" & vbCrLf & vbCrLf & _
               "Math: - " & Range("F" & i) & vbCrLf & _
               "Network: - " & Range("G" & i) & vbCrLf & _
               "Physics: - " & Range("H" & i) & vbCrLf & _
               "Antenna: - " & Range("I" & i)

    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.htmlBody = StringToHTML(mailBody)
    objEmail.HtmlBodyPart.Charset = "utf-8"
    objEmail.Send

    Set objFlds = Nothing
    Set objConf = Nothing
    Set objEmail = Nothing
    Next i
End Sub

Function StringToHTML(sStr As String) As String
    sStr = Replace(sStr, Chr(10), "<br/>")
    sStr = Replace(sStr, Chr(13), "<br/>")
    sStr = Replace(sStr, Chr(11), "<br/>")
    StringToHTML = "<!doctype html><html lang=""en""><body><p>"
    StringToHTML = StringToHTML & sStr
    StringToHTML = StringToHTML & "</p></body></html>"
End Function
Источник

@Super Symmetry, На самом деле я благодарен за ваше сотрудничество, я все еще получаю ошибку

Мой текущий код

 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 = "laggnaimtehan@gmail.com"
     mailpassword = "*****"
     ''''''''
     Dim n As Integer
     n = Application.WorksheetFunction.CountA(Range("c:c"))
     For i = 2 To n
     
     mailto = Range("c" & i).Value
     mailSubject = Range("e" & i).Value
     mailBody = "Hi " & Range("b" & i) & "," & vbCrLf & vbCrLf & _
               "Below you can find your marks:" & vbCrLf & vbCrLf & _
               "Math: - " & Range("F" & i) & vbCrLf & _
               "Network: - " & Range("G" & i) & vbCrLf & _
               "Physics: - " & Range("H" & i) & vbCrLf & _
               "Antenna: - " & Range("I" & i)

    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.HTMLBodyPart.Charset = "utf-8"
    objEmail.HTMLBody = StringToHTML(mailBody)
    objEmail.TextBodyPart.Charset = "utf-8"
    objEmail.BodyPart.Charset = "utf-8"
    objEmail.Send

    Set objFlds = Nothing
    Set objConf = Nothing
    Set objEmail = Nothing
    Next i
  End Sub

   Function StringToHTML(sStr As String) As String
     sStr = Replace(sStr, Chr(10), "<br/>")
     sStr = Replace(sStr, Chr(13), "<br/>")
     sStr = Replace(sStr, Chr(11), "<br/>")
     StringToHTML = "<!doctype html><html lang=""en""><body><p>"
     StringToHTML = StringToHTML & sStr
     StringToHTML = StringToHTML & "</p></body></html>"
    End Function

Заранее спасибо....

Источник
Другие вопросы по тегам