Question

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

    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 = "abc@abc.ch"
    .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

用于通过电子邮件将选择从工作表发送到提供程序的VBA代码

1 个答案: