VBA Excel 使用父 MailEnvelope 发送电子邮件，简介中带有 HTML 链接-解网

问：

使用 outlook 将 html 超链接添加到电子邮件正文似乎很简单。但是，我想在电子表格中发送一系列单元格，并在介绍中发送指向文件的链接。或者单击电子邮件中创建的图像并链接到文件的简单方法。

我有以下代码，但是如果我将介绍指定为 HTMLintroduction，则 strbody 不允许它。

有什么想法吗？

Sub SendMail2()



Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
'Dim Sendrng As Range

Set Sendrng = Worksheets("Dashboard").Range("A1:Q34")

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

    strbody = "<font size=""3"" face=""Calibri"">" & _
               ActiveWorkbook.Name & "</B> is created.<br>" & _
              "Click on this link to open the file : " & _
              "<A HREF=""file://" & ActiveWorkbook.FullName & _
              """>Link to the file</A>"

With Sendrng

ActiveWorkbook.EnvelopeVisible = True
    With .Parent.MailEnvelope
        .Introduction = strbody


On Error Resume Next
  With ActiveSheet.MailEnvelope.Item
        .To = "[email protected]"
        .CC = ""
        .BCC = ""
        .Subject = ActiveWorkbook.Name
        '.HTMLBody = strbody
        .Display   'or use .Send
    End With

    End With

    End With

    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
Else
    MsgBox "Email not sent."
End If
End Sub

html VBA 电子邮件 excel

Sub Make_Outlook_Mail_With_File_Link()
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
'Working in Excel 2000-2013
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String

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

        strbody = "<font size=""3"" face=""Calibri"">" & _
                  "Colleagues,<br><br>" & _
                  "I want to inform you that the next sales Order :<br><B>" & _
                  ActiveWorkbook.Name & "</B> is created.<br>" & _
                  "Click on this link to open the file : " & _
                  "<A HREF=""file://" & ActiveWorkbook.FullName & _
                  """>Link to the file</A>" & _
                  "<br><br>Regards," & _
                  "<br><br>Account Management</font>"

        On Error Resume Next
        With OutMail
            .To = "[email protected]"
            .CC = ""
            .BCC = ""
            .Subject = ActiveWorkbook.Name
            .HTMLBody = strbody
            .Display   'or use .Send
        End With
        On Error GoTo 0

        Set OutMail = Nothing
        Set OutApp = Nothing
    Else
        MsgBox "The ActiveWorkbook does not have a path, Save the file first."
    End If
End Sub

    Sub SendRangeAsPictureInMailWithHyperlink()
    Dim OutlookApp As Object
    Dim Mail As Object
    Dim WordDoc As Object
    Dim ExcelRange As Range
    Dim InlineShape As Object

    ' Define the range in Excel that you want to copy
    Set ExcelRange = ThisWorkbook.Sheets("YourSheetName").Range("A1:C3")

    ' Copy the range as a picture
    ExcelRange.CopyPicture Appearance:=xlScreen, Format:=xlPicture

    ' Create an Outlook instance
    On Error Resume Next
    Set OutlookApp = GetObject(, "Outlook.Application")
    If Err.Number <> 0 Then
        Set OutlookApp = CreateObject("Outlook.Application")
    End If
    On Error GoTo 0

    ' Create a new email
    Set Mail = OutlookApp.CreateItem(0)

    With Mail
        .To = "[email protected]"   ' Set the recipient
        .Subject = "Subject of the Email"  ' Set the subject
        .HTMLBody = "<font size=""3"" face=""Calibri"">" & _
                ActiveWorkbook.Name & "</B> is created.<br>" & _
                "Click on this picture to open the file :"  ' Set the body text of the email

        ' Display the email window
        .Display

        ' Insert picture at the end of the email text
        Set WordDoc = .GetInspector.WordEditor
        WordDoc.Range.InsertAfter vbCrLf & vbCrLf  ' Adds two new lines at the end
        WordDoc.Range.Characters.Last.Paste
        Set InlineShape = WordDoc.InlineShapes(WordDoc.InlineShapes.Count)
        
        ' Add a hyperlink to the picture
        With WordDoc.Hyperlinks
            .Add Anchor:=InlineShape, Address:="file://" & ActiveWorkbook.fullname  'Or Address:="https://www.google.com/"
        End With
        
    End With

    ' Cleanup
    Set Mail = Nothing
    Set OutlookApp = Nothing
    Set ExcelRange = Nothing
End Sub

:)

上一个：Laravel 5.2：预期响应代码 220，但收到代码“500”，并显示消息“500 无法识别的命令”

下一个：VBA Excel 使用父 MailEnvelope 发送电子邮件，简介中带有 HTML 链接

VBA Excel 使用父 MailEnvelope 发送电子邮件，简介中带有 HTML 链接

vba excel send email using parent mailenvelope with html link in the introduction

评论

评论