vba发送电子邮件并打印为pdf并保存到文件夹?

时间:2017-01-16 21:22:16

标签: excel vba email pdf

我有一个像这样的excel工作簿:

Column B                         Column Q

C:\Folder1\File.xls              email
C:\Folder2\File.xls              email
C:\Folder3\File.xls              email

当我运行下面的宏时,它会向Q列中的每个收件人发送一封电子邮件。它还会在其发出的每封电子邮件中附加列B中的每个相应附件。

Sub email23()

'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
'Working in Office 2000-2016
    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range

    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")

    On Error GoTo cleanup
    For Each cell In Columns("Q").Cells.SpecialCells(xlCellTypeConstants)
        If cell.Value Like "?*@?*.?*" And _
           LCase(Cells(cell.Row, "B").Value) <> "" Then

            Set OutMail = OutApp.CreateItem(0)
            On Error Resume Next
            With OutMail
                .To = cell.Value
                .subject = "Attention Required: Promotion Announcement for Week " & Range("O10").Value & " " & Range("O13").Value
                .Body = "Good " & Range("A1").Value & "," _
                      & vbNewLine & vbNewLine & _
                      "Thank you for your interest in participating in this weeks special promotion. Please see the details below." _
                      & vbNewLine & vbNewLine _
                                     & vbNewLine & vbNewLine _
                      & Range("D10").Value _
                      & vbNewLine & vbNewLine _
                      & "Thank you and kind regards / Danke und freundliche Grüße," _
                      & vbNewLine & vbNewLine _
                      & "The Food Specials Team" _
                      & vbNewLine

                'You can add files also like this
                .Attachments.Add (cell.Offset(0, -15).Value)
                .Send  'Or use Display

            End With

            OutMail.PrintOut

            On Error GoTo 0
            Set OutMail = Nothing
        End If
    Next cell

cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True

End Sub

这很好用,但现在我想打印发送的电子邮件并将其作为pdf保存到与附件相同的文件夹中。

到目前为止,我已经尝试过打印输出,但这似乎没有做任何事情。请有人告诉我我哪里出错了?

由于

1 个答案:

答案 0 :(得分:0)

这是非常晚的,但是当我搜索解决类似你的问题的解决方案时,我来到了这个帖子。

我注意到的一件事是

OutMail.PrintOut 

之后

End With

,这可能导致问题。