VBA代码用于通过电子邮件从工作表中select一个提供者

我写了一些代码，将提供商的报告分解成每个提供商的单独报告，然后将它们保存到桌面上的文件夹中，通过电子邮件发送给提供商。 现在我想添加一些代码，将自动发送电子邮件给我这些提供者，但让我先看看之前发送。 这是我的旧代码。

Sub VendorSeperate() Application.DisplayAlerts = False wb1 = ActiveWorkbook.Name SaveFolder397 = Format(Now(), "mm.dd.yy hh mm ss AM/PM") SaveFolder400 = "C:\Users\johndoe\Desktop\Test\" & SaveFolder397 On Error Resume Next MkDir SaveFolder400 On Error GoTo 0 [A2].Select ActiveWindow.FreezePanes = True batchdate = Format(Cells(2, 1), "mm.dd.yy") & " Sent " & Format(Now(), "mm.dd.yy") LR1 = Columns(1).Find("*", SearchDirection:=xlPrevious).Row For I = 2 To LR1 + 2 If Cells(I, 1) = "" And Cells(I - 1, 1) <> "" Then providername = Trim(Cells(I - 1, 7)) ActiveSheet.Copy Cells.AutoFilter Field:=7, Criteria1:="<>*" & providername & "*", Operator:=xlAnd Rows("2:" & LR1 + 100).SpecialCells(xlCellTypeVisible).Delete Cells.AutoFilter ActiveWindow.ScrollColumn = 1 ActiveWindow.ScrollRow = 1 ActiveWorkbook.SaveAs Filename:=SaveFolder400 & "\JD2.0 " & providername & " Ck Batch Date " & batchdate & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False ActiveWorkbook.Close Workbooks(wb1).Activate End If Next I End Sub 

Answer 1

这是一个非常简单的代码发送电子邮件与Outlook。 也许这可以帮助你。

 Sub mail() Dim OutApp As Object Dim OutMail As Object Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0) On Error Resume Next With OutMail .to = "[e-mail]" .CC = "" .BCC = "" .Subject = "Subject line" .Body = "Email text." .Attachments.Add ActiveWorkbook.FullName .Display End With On Error GoTo 0 Set OutMail = Nothing Set OutApp = Nothing End Sub