MACRO - Envoi mail si données avec filtre

Bonjour,

Je me permets de venir appeler à l’aide pour un problème sur une macro que je souhaite créer.

Dans mon tableau, j’ai réussi à mettre en place avec des bouts de codes trouvés sur internet une grande partie de ce que je souhaitais (aucune idée si le code est le + simple mais il fonctionne )

Voilà ce qui me fait buger désormais.

Sur l’onglet « MAIL » du fichier en pièce jointe, l’utilisateur doit pouvoir sélectionner le « fourn » et le mois souhaité.

Ensuite, en cliquant sur le bouton « Envoi du mail », ça enverra automatiquement les données de l’onglet correspondant au fourn choisi et à la période souhaitée (prévenir si aucune donnée et ne pas envoyer de mail).

En colonne « C » sur les onglets des fourn se trouvent les dates, et donc les périodes.

Le(s) mail(s) de contact sera(ont) les données de la colonne « C » ou de la cellule « G9 » de l'onglet "MAIL"

Enfin, si le fourn est « tous », cela crée un mail pour tous les fourn mais séparément (30 mails pré-remplis par exemple).

A savoir que les colonnes A, B et C de l’onglet « MAIL » seront masquées et je serai le seul à modifier les contacts.

Voici un code top que j’ai déjà utilisé pour un autre tableau, si ca peut mettre des personnes sur la piste

Sub EnvoiMail()

If MsgBox("Envoyer la demande aux personnes concernées ?", 36, "Confirmation") = vbYes Then

    Dim rng As Range
    Dim OutApp As Object
    Dim OutMail As Object

    Set rng = Nothing
    On Error Resume Next

    Set rng = Sheets("Demande ").Range("B1:J46").SpecialCells(xlCellTypeVisible)
    On Error GoTo 0

    If rng Is Nothing Then
        MsgBox "Erreur de sélection" & _
               vbNewLine & "Contacter OIIR", vbOKOnly
        Exit Sub
    End If

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
    With OutMail
        .To = "aaa.bbb@CCC.com"
        .CC = ""
        .BCC = ""
        .Subject = "Demande d'accès " & Range("D21").Value & " (" & Range("D25").Value & ")"
        .HTMLBody = RangetoHTML(rng)
        .Send
    End With
    On Error GoTo 0

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing

    MsgBox "Le mail a été envoyé"

End If

End Sub

Function RangetoHTML(rng As Range)

    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook

    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With

    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.readall
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")

    TempWB.Close savechanges:=False

    Kill TempFile

    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function

Excellente journée et un grand merci d’avance,

Loïc

34test-mails.xlsm (130.11 Ko)

Bonjour à tous,

Pour information, j'ai déjà réussi à avancer sur une partie du sujet :

Désormais j'arrive à envoyer le mail d'après le fourn. et à l'adresse mail correspondante à ce fourn.

Mes problèmes persistants sont :

  • le filtrage du mois
  • la selection des données dans l'onglet (inclues entre les colonnes A et J mais lignes variables)
  • prévenir si aucune donnée à envoyer
  • envoyer plusieurs mails si "tous" est sélectionné.

Je vous mets en pièce jointe le tableau mis à jour.

Bonne journée,

Loïc

39test-mails.xlsm (138.19 Ko)
Rechercher des sujets similaires à "macro envoi mail donnees filtre"