时间戳

首页 > 解决方案 > 在电子邮件正文中包含单元格值

excel - 在电子邮件正文中包含单元格值

问题描述

我的代码正在通过 Outlook 发送电子邮件。
我希望电子邮件正文中包含两个单元格的值。
格式正常，文本正确显示。
此外，在两种情况之一中，单元格值也会正确显示。

对于代码的一部分，它在单元格值前面添加“ACCT:ACCT:ACCT:”。

单元格 (6,3)
的单元格值 = Zeer Dringend 单元格 (22,3) 的单元格值 = 2019-0004

这是代码生成的电子邮件正文

贝斯特·科莱加，

Een nieuwe retour zending registratie werd aangemaakt 遇到紧急情况：**ACCT:ACCT:ACCT:Zeer Dringend**。

Het pakket 编号是 **2019-0004**。


在 geval van vragen gelieve 联系 op te nemen。

遇见 vriendelijke groeten，

在显示 ACCT:ACCT:ACCT:Zeer Dringend的地方，应该说Zeer Dringend

这是完整的代码

Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Dim WS As Worksheet

If ActiveWorkbook.Path <> "" Then
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
Set WS = Sheets("Ingave")

strbody = "<font size=""3"" face=""Calibri"">" & _
"Beste Collega,<br><br>" & _
"Een nieuwe retour zending registratie werd aangemaakt met urgentie: <B>" & WS.Cells(6, 3).Value & "</B>.<br>" & _
"Het pakket nummer is <B>" & WS.Cells(22, 3).Value & "</B>.<br><B> " & _
"</B><br><br>In geval van vragen gelieve contact op te nemen." & _
"<br><br> Met vriendelijke groeten, </font>"
On Error Resume Next

With OutMail
.to = "xxx@yyy"
.CC = ""
.BCC = ""
.Subject = "Nieuwe registratie retour pakket "
.HTMLBody = strbody
.Display   'or use .Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
Else
MsgBox "U moet de file eerst opslaan voor u verder kan gaan."
End If

标签： excelvbaemailoutlookcell

解决方案

您提供的代码似乎按预期工作，您应该尝试调查ACCT:ACCT:ACCT:字符串的实际来源，也许以下帮助，我已将 ActiveWorkbook 更改为 ThisWorkbook 以消除代码从工作簿中获取数据的可能性这可能是活跃的，但不一定是预期的：

Sub Send_Email()
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Ingave")
'make sure that we are looking at the this workbook and not the Active one.

If ThisWorkbook.Path <> "" Then
'make sure the workbook has been saved, so we get a Path property.

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    strbody = "<font size=""3"" face=""Calibri"">" & _
    "Beste Collega,<br><br>" & _
    "Een nieuwe retour zending registratie werd aangemaakt met urgentie: <B>" & ws.Cells(6, 3).Value & "</B>.<br>" & _
    "Het pakket nummer is <B>" & ws.Cells(22, 3).Value & "</B>.<br><B> " & _
    "</B><br><br>In geval van vragen gelieve contact op te nemen." & _
    "<br><br> Met vriendelijke groeten, </font>"
    'On Error Resume Next

    With OutMail
        .to = "xxx@yyy"
        .CC = ""
        .BCC = ""
        .Subject = "Nieuwe registratie retour pakket "
        .HTMLBody = strbody
        .Display   'or use .Send
    End With
    'On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
Else
    MsgBox "U moet de file eerst opslaan voor u verder kan gaan."
End If
End Sub

推荐阅读