Autres VBA Fusionner puis envoyer Word avec Outlook

FOUQUET Yves

XLDnaute Occasionnel
Bonsoir à toutes et tous,

Je voudrais envoyer automatiquement des CERFA (impôts) à partir du liste de feuille EXCEL. "cerfa_list"
Cette liste est issue d'un trie à partir d'une autre feuille " effectif"
Je voudrais donc utiliser un document WORD contenant 4 zones de fusion "nom, prénom, adresse, code postal, ville"
Ces quatre zones du document correspondent à 4 cellules de ma feuille "cerfa_list" qui comporte en plus une cellule pour le mail.
Pour l'heure je fais le trie dans ma nouvelle feuille, ça je sais!

J'ai bien une procédure pour envoyer une image dans le corps du message et en pièce jointe, mais là cela ne correspond pas à mon besoin.

Alors je séche, et je ne sais pas comment faire sachant que je voudrais dans un premier temps fusionner, puis envoyer les mails, avec sa pièce jointe, à chaque personne.
Au bout cela représente environ 200 mails à faire partir automatiquement.

Je suis dans un userform avec trois boutons: 1 quitter, 2 fusionner, 3 envoyer.
je vous mets les lignes de mon Userform et si une bonne personne pouvait m'aider alors ce serai parfait.

Merci d'avance, mais vraiment, envoyer 200 mails, un à un, c'est vraiment fastidieux.

Yves


VB:
Option Explicit  'Activation de la déclaration explicite des variables
Dim Ws As Worksheet  'Variable pour un Objet Worksheet en PUBLIC pour tous les Controls de cet UserForm
Dim Rng As Range

' --- variables pour récupérer infos du trie ---
Dim nom As String
Dim prenom As String
Dim adresse As String
Dim c_postal As String
Dim ville As String
Dim mail As String

Dim annee As String  '--- année en cours pour base du trie ---

Dim j As Long
Dim i As Integer
Dim ligne As Integer
Dim fin As Integer

'Correspond au programme du bouton QUITTER
Private Sub commandbutton1_Click()
Unload Me
Application.DisplayAlerts = False   'supprime l'alerte
Sheets("cerfa_list").Delete           ' supprime la feuille "cerfa_list" créée
Application.DisplayAlerts = True   'remet l'alerte
End Sub

'============= debut procedure ouverture Outlook =======================
Function OutlookOuvert() As Boolean
  Dim oOL As Object
  On Error Resume Next
  Set oOL = GetObject(, "Outlook.Application")
  On Error GoTo 0
  OutlookOuvert = Not (oOL Is Nothing)
  Set oOL = Nothing
End Function
'--------------------------
'---- bouton fusionner click
Private Sub commandbutton3_Click()  '==== FUSIONNER LE NOUVELLE FEUILLE AVEC DOC WORD (4 zones) ======
Set Ws = Sheets("cerfa_list")
For j = 2 To Ws.Range("B" & Rows.Count).End(xlUp).Row

'-------
[B][I]' PROCEDURE FUSIONNER mailing avec doc word, à écrire !!! Je ne sais comment faire[/I][/B]
'--------

End Sub
'-------

Private Sub commandbutton2_Click()  '==== ENVOYER LES MAILS en  MAILING ====
Dim PathName As String
Dim i As Integer


[B][I]'=== là il faut envoyer les mails avec piéce jointe "le cerfa" mais je suis perdu ===[/I][/B]

If OutlookOuvert = False Then i = Shell("Outlook", vbNormalNoFocus)
EmbedPicture "D:\Gestion AHI\cerfa\ cerfa_fus.docs"  ' XXXX.jpg"
End Sub

'=============================================
Set myApp = CreateObject("Outlook.Application")
Set myItem = myApp.CreateItem(olMailItem)
myItem.Subject = "Votre CERFA pour cotisation A.H.I"
myItem.Body = "cerfa"
myItem.Attachments.Add ThisDocument.Path & "\" & ThisDocument.Name
myItem.To = Range("J" & ligne).Value
myItem.Display
'myItem.Send

Next
End Sub

'=============================================================================
Sub AjouterFeuilleDevantUneAutreFeuille()
Sheets.Add before:=Worksheets("cerfa_list") 'ajouter une Feuille "rappel_c" devant la Feuille effectif
End Sub
'=============================================================================
'==== procédure de trie de la liste et récupération dans nouvelle feuille
'==== des cotisants de l'année ===
Private Sub UserForm_Initialize()

Sheets.Add.Name = "cerfa_list"                                '--- création de la nouvelle feuille pour résultat du trie ---
ligne = 1
fin = 0
compte_pas = 0
annee = Mid(Date, 7, 4)                                             ' année en cours correspondant à l'année recherchée

For j = 2 To Ws.Range("B" & Rows.Count).End(xlUp).Row
     m_annee = Sheets("effectif").Range("E" & j)        ' année de cotisation de la liste effectif
     '--- trie sur l'année de cotisation -----------
     If m_annee = annee Then
       
       nom = Sheets("effectif").Range("B" & j)
       Range("A" & ligne).Value = nom
       'Insére le nom colonne A
       prenom = Sheets("effectif").Range("C" & j)
       Range("B" & ligne).Value = prenom
       'Insére le prénom colonne B
       adresse = Sheets("effectif").Range("G" & j)
       Range("C" & ligne).Value = adresse
       'Insére adresse colonne C
       c_postal = Sheets("effectif").Range("H" & j)
       Range("D" & ligne).Value = c_postal
       'Insére code postal colonne G
       ville = Sheets("effectif").Range("I" & j)
       Range("E" & ligne).Value = ville
       'Insére la ville colonne D
       mail = Sheets("effectif").Range("J" & j)
       Range("F" & ligne).Value = mail
       'Insére mail colonne D
         
       ligne = ligne + 1
     End If
Next j
End Sub
 

Discussions similaires

Réponses
11
Affichages
236
Réponses
6
Affichages
99

Statistiques des forums

Discussions
311 725
Messages
2 081 942
Membres
101 849
dernier inscrit
florentMIG