时间戳

首页 > 解决方案 > 通过 excel 信封发送表格时，如何获取表格格式？

excel - 通过 excel 信封发送表格时，如何获取表格格式？

问题描述

当我尝试通过 Excel 的信封通过电子邮件发送我制作的表格时，数据及其在表格中的位置会继续存在，但颜色、边框等不会。

在这种情况下，我试图按下按钮，让它复制我的表格范围并将其发送出去。我希望在输出中获得尽可能好的匹配。请参阅下面的代码和屏幕截图:)

Sub DEQACreateAndSend()

' Auto Adjust Sizing based off amount of data given
ActiveSheet.Range("B4:C15").Columns.AutoFit

   ' Select the range of cells on the active worksheet.
   ActiveSheet.Range("B8:C15").Select

Dim cell As Range
Dim rng As Range
Set rng = Range("C7:C14") 'enter your range

On Error Resume Next
    Dim errMsg As String
    For Each cell In rng
    Dim CellString As String
    CellString = cell.Value
    Dim CellLen As Integer
    CellLen = Len(Trim(CellString))

    If CellLen < 1 Then
        errMsg = "Please fill out All required fields!"
    End If
Next cell

If errMsg <> "" Then
    MsgBox errMsg
Else
   ' Show the envelope on the ActiveWorkbook.
   ActiveWorkbook.EnvelopeVisible = True

   ' Set the optional introduction field thats adds
   ' some header text to the email body. It also sets
   ' the To and Subject lines. Finally the message
   ' is sent.
   With ActiveSheet.MailEnvelope
      .Introduction = ""
      .Item.To = Range("C5")
      If IsEmpty(Range("F3").Value) = True Then
        .Item.Subject = Range("C4")
        Else
        .Item.Subject = ActiveSheet.Range("F3").Text + ActiveSheet.Range("C4")
        End If
        .Item.CC = Range("C6")
      .Item.Send
   End With
   ActiveWorkbook.MailEnvelope = False

End If

' Reset Sizing
With ActiveSheet.Columns("C")
    .ColumnWidth = 87
    End With
With ActiveSheet.Columns("B")
    .ColumnWidth = 25.55
    End With
' Set Active Cell to first field
    ActiveSheet.Range("C4").Select


End Sub

在此处输入图像描述

在此处输入图像描述

标签： excelvba

解决方案

这将是很长的道歉......但它的工作原理。

我能够将带有格式的表格添加到 Outlook 电子邮件的唯一方法是首先将 excel 表格转换为 HTML 表格。然后，将 HTML 表格添加到您的电子邮件中。

这是将带有格式的 Excel 表格转换为 HTML 范围的宏。这里的输入是表格的范围。这需要像这样从一个单独的宏（实际构建和发送电子邮件）调用

Set EmailTable = Range("??:??")
RangetoHTML(EmailTable)

注意上面的代码在实现的时候最后一个共享的宏中存放在哪里

Option Explicit

Function RangetoHTML(EmailTable As Range)

''''''''''''''''''''''''''''''''''''''''''''''''''''
'Funciton to convert an excel range to a HTML table

    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook

    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"


    EmailTable.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With

    'Publish the sheet to a htm file
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With

    'Read all data from the htm file into RangetoHTML
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.readall
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")

    'Close TempWB
    TempWB.Close savechanges:=False

    'Delete the htm file we used in this function
    Kill TempFile

    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function

我不知道这是否适用于信封，但我不认为这是从 excel 发送电子邮件的最佳方式。相反，请访问 Outlook 对象以获得更多控制权。您可以使用此模板（直接从我在过去 3 年中每年成功使用一次以发送数千封电子邮件的宏中直接复制）来帮助您入门。

请注意，.HTMLBody上面调用了宏。无论你在哪里调用这个宏，你的桌子都会在哪里降落。

Sub Sender ()

Dim OutApp As Object
Dim OutMail As Object
Dim EmailTable as Range
Dim EmailBody as String
EmailBody = "THIS IS YOUR EMAIL BODY"

On Error GoTo FML:
    Set EmailRange = 'INSERT RANGE HERE
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
        With OutMail
            .to = "To"
            .Subject = "Subject"
            .HTMLBody = "" _
                        & "Hi " 
                        & "<br>" _
                        & EmailBody _
                        & RangetoHTML(EmailTable)

            'Change to .Send to actually send emails
            .Display

        End With
  Exit Sub

FML:
    Set OutApp = Nothing
    Set OutMail = Nothing
    'I usually write to a dynamic cell here denoting failure and pass along any relevant info (.to maybe?)

End Sub

数千封电子邮件当然是公司内部的。我不是垃圾邮件发送者:)

推荐阅读