Question

以下代码用于发送带附件的电子邮件，并且可以正常使用。我遇到的问题是：

再次调用代码以执行相同的功能，但附件在发送后不会删除，因此，它会继续将新附件添加到已发送的现有批次中。我试图在添加附件之前添加“.Attachments.Remove”，但在此行上不断出现错误。
我非常感谢您提供帮助的第二件事，就是告诉代码何时“停止”，如果我们说，下一封电子邮件之前已经发送过，那么请继续下一封电子邮件，等等，如果所有电子邮件都已发送，何时停止。

Sub email_PO()


Application.DisplayAlerts = False
File_name = Sheet2.Cells(3, 10)
attach_name = Sheet2.Cells(28, 10)
attach_file = Sheet2.Cells(60, 10)
pasteAt = Sheet2.Cells(62, 10)

Windows(File_name).Activate
Sheets("Control").Select
Bodytosend = Sheet2.Range("A581:E596")

mail_to_ATTA = Sheet2.Cells(58, 10)
mail_cc_ATTA = Sheet2.Cells(59, 10)
Subject = Sheet2.Cells(57, 10)

Sheets("Control").Select
Range("A39").Select
ActiveSheet.Hyperlinks.Add ANCHOr:=Selection, Address:= _
attach_link, TextToDisplay:= _
""

Dim Sendrng As Range
Application.DisplayAlerts = False
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Sheets("Control").Select
Range("A581:H604").Select
Set Sendrng = Selection
With Sendrng
ActiveWorkbook.EnvelopeVisible = True
With .Parent.MailEnvelope
.Introduction = ""

With .Item


.To = mail_to_ATTA
.Cc = mail_cc_ATTA
.Subject = Subject
.Attachments.Remove
.Attachments.Add (attach_file)
.VotingOptions = "Purchased Order Acknowledged & Agree to T&C's;Purchase Order Declined"
.SEND
End With
End With

End With

StopMacro:
With Application
    .ScreenUpdating = True
    .EnableEvents = True
End With
ActiveWorkbook.EnvelopeVisible = False


Windows(File_name).Activate

Sheets("Control").Select
Range("J61").Select
Selection.Copy
Sheets("PO Tracker").Select
Range(pasteAt).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False


Range("A1").Select

Call email_PO


Exit Sub

End Sub

Answer 1

.Attachments.Remove 1可以工作 MSDN表示＆＃34;集合中对象的从1开始的索引值。＆＃34;或者在非专业人员的讲话中，你需要告诉它要删除哪个附件

不确定您是否使用Outlook，但在VBA中，您可以尝试使用＆＃34;工具＆＃34; ＆GT; ＆＃34;参考文献＆＃34;并添加Microsoft Outlook SharePoint社交提供程序，社交提供程序可扩展性和视图控制

如果您需要进一步澄清任何内容，请发表评论，我会尽快回复您

循环播放电子邮件后，附件不会删除

1 个答案: