ワークシートからプロバイダーに選択肢をメールで送信するためのVBAコード

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