直接通过电子邮件发送Excel工作表作为PDF

Question

我的目标是能够单击一个按钮并将我的Excel工作表转换为PDF的一系列电子表格，并通过电子邮件将其发送到一个电子邮件地址，该地址位于工作表中的一个单元格中。对于初学者，我有一些代码可以将一系列单元格转换为PDF文件并允许我保存它：

Option Explicit
Sub savePDF()
Dim wSheet As Worksheet
Dim vFile As Variant
Dim sFile As String

Set wSheet = ActiveSheet
sFile = Replace(Replace(Range("D11"), " ", ""), ".", "_") _
        & "_" _
        & Range("H11") _
        & ".pdf"
sFile = ThisWorkbook.Path & "\" & sFile

With Excel.Application.FileDialog(msoFileDialogSaveAs)

Dim i As Integer
For i = 1 To .Filters.Count
    If InStr(.Filters(i).Extensions, "pdf") <> 0 Then Exit For
Next i

.FilterIndex = i
.InitialFileName = sFile

.Show
If .SelectedItems.Count > 0 Then vFile = .SelectedItems.Item(.SelectedItems.Count)

End With

If vFile <> "False" Then
wSheet.Range("A1:BF47").ExportAsFixedFormat _
    Type:=xlTypePDF, _
    Filename:=vFile, _
    Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, _
    OpenAfterPublish:=False

End If
End Sub

任何人都可以操纵此代码（附加到按钮），这样当点击按钮时它会通过电子邮件发送特定单元格中的电子邮件地址，并且作为额外的奖励，让电子邮件的主题从单元格开始工作在电子表格中呢？

Answer 1

我有一个解决方案，如下所示。通过进入页面支付然后设置打印区域来设置我的打印区域后，我成功地将excel表格通过电子邮件发送为PDF文件：

Sub savePDFandEmail()

Dim strPath As String, strFName As String
Dim OutApp As Object, OutMail As Object

strPath = Environ$("temp") & "\"  trailing "\"

strFName = ActiveWorkbook.Name
strFName = Left(strFName, InStrRev(strFName, ".") - 1) & "_" & ActiveSheet.Name & ".pdf"

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    strPath & strFName, Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

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

On Error Resume Next
With OutMail
    .to = Range("CB4")
    .CC = Range("CB6")
    .BCC = ""
    .Subject = Range("CB8")
    .Body = Range("BW11") & vbCr
    .Attachments.Add strPath & strFName
    '.Display    'Uncomment Display and comment .send to bring up an email window before sending
    .Send        'Keep this the same if you want to send the email address out on click of the button
End With

Kill strPath & strFName
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing
End Sub

我还需要在我的工作表中添加一些电子邮件工具，如下所示：

点击该按钮现在将发送附有PDF文件的电子邮件。