Boucle sur envoi automatique

[Solo_Wing75]

Bonjour à tous,

Je fais appel aux personnes plus expérimentés du forum en vous remerciant d'avance pour votre aide !

Voilà, j'ai pu construire la macro plus bas. Mon but était de construire une boucle qui envoie tout les onglets taggé à des destinataires différents + un onglet à part qui est le meme pour tout le monde (ici "RULES")

Le problème est que j'envoie toujours le meme onglet à chacun des destinataires au lieu que chacun recoivent le sien. Et c'est toujours l'onglet actif au moment d'envoyer la macro.

Vous sauriez quel termes je dois utiliser pour corriger ça ? Un grand merci d'avance une nouvelle fois !

Sub Mail_All_2()
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim sh As Worksheet
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object
Dim S As Shape

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

For Each sh In ThisWorkbook.Worksheets
If sh.Range("T2").Value Like "?*@?*.?*" Then

'Copie la feuille active comme nouvelle feuille
ThisWorkbook.Sheets(Array(ActiveSheet.Name, Sheets("RULES").Name)).Copy
Set Destwb = ActiveWorkbook
  
'Désactiver fenêtre de compatibilité
        Application.DisplayAlerts = False

TempFilePath = Environ$("temp") & "\"
TempFileName = ActiveSheet.Name


Set OutApp = CreateObject("outlook.application")
Set OutMail = OutApp.CreateItem(0)


With Destwb
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=TempFilePath & TempFileName & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, ignoreprintareas:=False, openafterpublish:=False        ' sauvegarde du fichier au format pdf

    On Error Resume Next
    With OutMail
        .to = Range("T2").Value & ";" & Range("U2").Value & ";" & Range("V2").Value & ";" & Range("W2").Value
        .CC = ""
        .BCC = ""
        .Subject = "Headcount management report AUGUST 2020"
        .Attachments.Add TempFilePath & TempFileName & ".pdf"
        .Body = "Dear All," & vbCrLf & "Please find attached your monthly country headcount management report." & vbCrLf & "Kind regards"
        '.display 'ou alors utiliser
        .Send 'pour envoi
    End With
    On Error GoTo 0
    .Close savechanges:=False
End With

    'Effacer le fichier envoyé
Kill TempFilePath & TempFileName & ".pdf"

Set OutMail = Nothing
Set OutApp = Nothing


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

End If
Next sh

Set OutMail = Nothing
Set OutApp = Nothing


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

End Sub

 

[sylvanu]

Bonjour Solo_wing,
Vous faites :

TempFileName = ActiveSheet.Name
puis
.Attachments.Add TempFilePath & TempFileName & ".pdf"

donc c'est toujours ActiveSheet qui est envoyée.
Tentez plutôt de changer la feuille comme :

TempFileName = Sheets("Nom de la feuille concernée")
puis
.Attachments.Add TempFilePath & TempFileName & ".pdf"

ou peut être aussi avec Sh.name ( je n'ai pas tout décodé )

 

[Solo_Wing75]

Merci, c'est surement le problème. Mais je voudrais que la feuille envoyé change au fil de la boucle.

Que l'onglet 1 soit envoyé, puis l'onglet 2, etc

Et toujours avec le second onglet"Rules" qui lui ne change pas. C'est la dessus que je bloque :-(

 

[Solo_Wing75]

Hello,

Je n'avais pas vu la seconde partie de la réponse.

Effectivement, en remplacant ActiveSheet.Name par sh.name cela fonctionne. Merci !