如何解决有关使用VBA的阿拉伯字符的建议
我正在努力向excel表中包含(学生姓名和他的标记)的每个学生发送电子邮件,如下所示
一切正常,但是当学生姓名为阿拉伯字符时。如下所示,名称显示为(????)
我将本地系统的设置更改为阿拉伯语,但是仍然遇到相同的问题。
有什么建议吗?
解决方法
您需要设置htmlBody
并使用utf-8字符集。
使用以下函数将文本字符串简单转换为html字符串。
Function StringToHTML(sStr As String) As String
sStr = Replace(sStr,Chr(10),"<br/>")
sStr = Replace(sStr,Chr(13),Chr(11),"<br/>")
StringToHTML = "<!doctype html><html lang=""en""><body><p>"
StringToHTML = StringToHTML & sStr
StringToHTML = StringToHTML & "</p></body></html>"
End Function
参考this,您需要用以下两行替换行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,"<br/>")
StringToHTML = "<!doctype html><html lang=""en""><body><p>"
StringToHTML = StringToHTML & sStr
StringToHTML = StringToHTML & "</p></body></html>"
End Function
,
@超级对称,非常感谢您的合作,我仍然会出错
我当前的代码
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,"<br/>")
sStr = Replace(sStr,"<br/>")
StringToHTML = "<!doctype html><html lang=""en""><body><p>"
StringToHTML = StringToHTML & sStr
StringToHTML = StringToHTML & "</p></body></html>"
End Function
谢谢....
版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。