2017-01-16 48 views
0

我有一個Excel工作簿像這樣:vba發送電子郵件並打印爲pdf並保存到文件夾?

Column B       Column Q 

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

當我運行下面的宏時,它將電子郵件發送到每個收件人在柱Q.它還在每個電子郵件它附加每個對應的附件在式柱乙發出。

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格式到同一文件夾作爲附件。

到目前爲止,我已經嘗試打印輸出,但這似乎沒有做任何事情。請有人能告訴我我要去哪裏?

感謝

回答

0

這是非常晚了,但google搜索解決類似你這樣的問題,當我來到這個線程。

有一兩件事我注意到的是

OutMail.PrintOut 

來後

End With 

,這可能會導致此問題。

相關問題