关于使用 VBA 的阿拉伯字符的建议
Advice about Arabic characters using VBA
我正在努力向每个学生发送包含来自 excel sheet 的(学生姓名和他的分数)的电子邮件,如下所示
一切正常,但是当学生姓名为阿拉伯字符时。名称显示为 ( ?????) 如下所示
我将本地系统的设置更改为阿拉伯语,但仍然遇到同样的问题。
有什么建议吗?
您需要设置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
我正在努力向每个学生发送包含来自 excel sheet 的(学生姓名和他的分数)的电子邮件,如下所示
一切正常,但是当学生姓名为阿拉伯字符时。名称显示为 ( ?????) 如下所示
我将本地系统的设置更改为阿拉伯语,但仍然遇到同样的问题。
有什么建议吗?
您需要设置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