Code VBA pour envoyer une sélection de la feuille de calcul à un fournisseur

Question

J'ai écrit un code qui décompose un rapport rempli de fournisseurs en rapports individuels pour chaque fournisseur, puis les a enregistrés dans un dossier sur mon bureau pour être envoyés par e-mail aux fournisseurs. Maintenant, je voudrais ajouter du code qui enverrait automatiquement ces fournisseurs par courriel pour moi, mais je voudrais d'abord jeter un coup d'oeil avant d'être envoyé. Voici mon ancien code.

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

Ceci est un code vraiment simple pour envoyer un email avec Outlook. Peut-être que cela peut vous aider.

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