通过VBA创建包含超链接的Outlook电子邮件

时间:2017-01-09 21:35:18

标签: excel vba excel-vba email outlook

我有一个宏,其目的是从excel中的文本框创建Outlook电子邮件。 问题是当我写一个单词并在其上放一个超链接时,当显示电子邮件时,超链接就不存在了。

Sub Envio()
Dim endereco, arquivo, destino, assunto, mensagem, nome, copia, anexo As String
Dim row, report As Integer
Dim i As Integer
Dim OutApp As Outlook.Application
Dim outMail As Outlook.MailItem

anexo = ThisWorkbook.Sheets("Mensagem").Cells(39, 2).Value
assunto = ThisWorkbook.Sheets("Mensagem").Cells(5, 2).Value
mensagem = ThisWorkbook.Sheets("Mensagem").[TextBox].Text & vbCrLf
copyblind = ThisWorkbook.Sheets("Mensagem").Cells(8, 2).Value


i = 2

destino = ThisWorkbook.Sheets("Emails").Cells(i, 1).Value



Do Until destino = ""
nome = ThisWorkbook.Sheets("Emails").Cells(i, 2).Value
copia = ThisWorkbook.Sheets("Emails").Cells(i, 3).Value


Application.DisplayAlerts = False
Set OutApp = CreateObject("Outlook.Application")
Set outMail = OutApp.CreateItem(olMailItem)


With outMail

.To = destino
If copia <> "" Then
.CC = copia
Else
.CC = ""
End If
.BCC = copyblind
.Subject = nome & ", " & assunto
.Body = mensagem
If anexo <> "" Then
.Attachments.Add (anexo)
End If
.BodyFormat = olFormatHTML
.HTMLBody = "<BODY style=font-size:11pt;font-family:Calibri>" & mensagem & "<BR><BR>" & _
"</BODY>"




.Display

End With

i = i + 1
destino = ThisWorkbook.Sheets("Emails").Cells(i, 1).Value

Set outMail = Nothing
Set OutApp = Nothing

Loop

Application.DisplayAlerts = True

End Sub

有人可以帮助我吗?

1 个答案:

答案 0 :(得分:0)

尝试在电子邮件正文中为链接添加HTML标记,如下所示:

<a href="https://yourhyperlink.com">Your Hyperlink</a>