时间戳

首页 > 解决方案 > 将 Excel 活动工作表作为带有其他附件的 pdf 发送电子邮件

vba - 将 Excel 活动工作表作为带有其他附件的 pdf 发送电子邮件

问题描述

我在 excel 中使用宏 VBA 脚本，它允许我将活动范围以 pdf 格式通过电子邮件发送给收件人。

这是代码

Sub AttachActiveSheetPDF()
  Dim IsCreated As Boolean
  Dim i As Long
  Dim PdfFile As String, Title As String
  Dim OutlApp As Object

  ' Not sure for what the Title is
  Title = Range("A1")

  ' Define PDF filename
  PdfFile = ActiveWorkbook.FullName
  i = InStrRev(PdfFile, ".")
  If i > 1 Then PdfFile = Left(PdfFile, i - 1)
  PdfFile = PdfFile & "_" & ActiveSheet.Name & ".pdf"

  ' Export activesheet as PDF
  With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile,     Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False,     OpenAfterPublish:=False
  End With

  ' Use already open Outlook if possible
  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = True
  End If
  OutlApp.Visible = True
  On Error GoTo 0

  ' Prepare e-mail with PDF attachment
  With OutlApp.CreateItem(0)

    ' Prepare e-mail
    .Subject = Title
    .To = "email@email.com" ' <-- Put email of the recipient here
    .CC = "" ' <-- Put email of 'copy to' recipient here
    .Body = "ùìåí øá," & vbLf & vbLf _
          & "øö''á ãå''ç òìåéåú îùìçú (îùåòø) ìàéùåø éåúí." & vbLf & vbLf _
          & "ááøëä," & vbLf _
          & Application.UserName & vbLf & vbLf
    .Attachments.Add PdfFile

    ' Try to send
    On Error Resume Next
    .Send
    Application.Visible = True
    If Err Then
      MsgBox "E-mail was not sent", vbExclamation
    Else
      MsgBox "E-mail successfully sent", vbInformation
    End If
    On Error GoTo 0

  End With

  ' Delete PDF file
  Kill PdfFile

  ' Quit Outlook if it was created by this code
  If IsCreated Then OutlApp.Quit

  ' Release the memory of object variable
  Set OutlApp = Nothing

End Sub

现在我需要这段代码来做同样的事情并将活动范围转换为 PDf 但我还需要允许我选择其他文件并将其作为附件添加到电子邮件中，我的 VBA 和 excel 宏技能不是那么好，我有不知道该怎么做。你能帮我改写我需要的代码吗？谢谢，丹。

标签： vbaexcel

解决方案

您应该更改此部分：

On Error Resume Next
.Send
Application.Visible = True
If Err Then
  MsgBox "E-mail was not sent", vbExclamation
Else
  MsgBox "E-mail successfully sent", vbInformation
End If

至：

.Save
.Close olPromptForSave
Application.Visible = True

这会将电子邮件保存在您的草稿文件夹中，以便您添加更多附件

推荐阅读