электронная почта Excel, активный лист в формате PDF с другими приложениями

Question

Я использую макрос VBA-скрипт в Excel, который позволяет отправлять активный диапазон по электронной почте получателю в формате 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 не так уж велики, и я понятия не имею, как это сделать.,Не могли бы вы помочь мне и переписать код, чтобы сделать, что мне нужно.Спасибо, Дэн.

Answer 1

Вы должны изменить этот раздел:

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

Это сохранит электронную почту в папке черновики , чтобы вы могли добавить дополнительные вложения