将excel活动工作表以pdf格式通过电子邮件发送给其他附件

时间:2018-10-08 12:40:24

标签: excel vba excel-vba

我在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宏技巧并不那么好我不知道该怎么做。您能否帮助我,并重写代码以实现我所需的功能。 谢谢, 担。

1 个答案:

答案 0 :(得分:0)

您应该更改此部分:

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

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