自学写的循环打印与发送邮件代码

auto737

经常执行打印，枯燥容易出错，自学写的循环打印与发送邮件代码！能正常执行！分享给高手看看，能否在精简完善下！

Sub 打印与发邮件()

  Sheets("扣款通知新").Select
    For i = Range("W2") To Sheets("数据源").Cells(Rows.Count, 1).End(xlUp).Row
        Sheets("扣款通知新").Range("T2") = "'" & Sheets("数据源").Cells(i, "A")
        Sheets("扣款通知新").Range("A1:T20").PrintOut
        Sheets("数据源").Cells(i, "AA") = "已打印"

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        "C:\Users\刁江\Desktop\供应商扣款单.pdf", Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, From:=1, To:=1, _
        OpenAfterPublish:=False

Dim objOutlook As New Outlook.Application
Dim objMail As MailItem
Set objOutlook = New Outlook.Application
Set objMail = objOutlook.CreateItem(olMailItem)
With objMail
            .To = "657599078@qq.com;auto737@sina.com"
            .Subject = "成都雅骏扣款通知"
            .Body = Sheets("扣款通知新").Range("Z2")
            .Attachments.Add "C:\Users\刁江\Desktop\供应商扣款单.pdf"
            .Send
End With
Set objMail = Nothing
Set objOutlook = Nothing
  Next
  
    MsgBox ("已完成打印并发送邮件")
End Sub