Dim NDF, NDF2, objet, listeContact As String
Dim Chemin As String
Dim WordApp As Word.Application
Dim WordDoc As Word.Document
Dim oApp As Outlook.Application
Dim oMail As Outlook.MailItem
'dossier où se trouve le fichier modèle
NDF = ActiveWorkbook.path & "\modele"
'là où sera sauvegardé le fihier temporaire publiposté
NDF2 = ActiveWorkbook.path & VPathD & "secret.htm"
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Chemin = ActiveWorkbook.path
ActiveWorkbook.SaveAs Chemin & "\Temp.xls"
' Fermer le classeur
ActiveWorkbook.Close savechanges:=False
Set WordApp = New Word.Application
Set WordDoc = WordApp.Documents.Open(NDF, ReadOnly:=False)
'sauvegarder temporairement la copie du modèle
WordDoc.SaveAs Chemin & "\tempModele.doc"
With WordDoc.MailMerge
' Si le fichier Excel n'est pas déjà lié dans le fichier Word
.OpenDataSource Name:=Chemin & "\Temp.xls", ConfirmConversions:=False, ReadOnly:=False, LinkToSource:=True, _
AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", WritePasswordDocument:="", WritePasswordTemplate:="", Revert:=False, _
Format:=wdOpenFormatAuto, _
Connection:="Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=" & Chemin & "\Temp.xls;Mode=Read;Extended Properties=""HDR=YES;IMEX=1;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet ", _
SQLStatement:="SELECT * FROM `feuille$`", SQLStatement1:="", SubType:=wdMergeSubTypeAccess
With .DataSource
.FirstRecord = wdDefaultFirstRecord
.LastRecord = wdDefaultLastRecord
End With
'Exécute l'opération de publipostage
.Execute Pause:=False
End With
' Sauvegarder le document de Publipostage en html et fermeture
WordDoc.Application.ActiveDocument.SaveAs2 Filename:=NDF2, _
FileFormat:=wdFormatHTML, LockComments:=False, Password:="", _
AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
:=False, SaveAsAOCELetter:=False, CompatibilityMode:=0
'création des mails
Set oApp = GetObject(, "Outlook.Application")
Set oMail = oApp.CreateItem(olMailItem)
'--------------------------------
'ces lignes permettent de récupérer le code source d'une page web
'comme le fichier publiposté est enregistré en ".htm" je récupère son code source avec les balises html
'qui vont se stocker dans la variable "sHtml"
Dim oIE As Object
Dim sHtml As String
Set oIE = CreateObject("InternetExplorer.Application")
oIE.navigate ("file:///" & NDF2)
Do While (oIE.Busy)
DoEvents
Loop
sHtml = oIE.Document.DocumentElement.outerHTML
oIE.Quit
'----------------------------------
'en mettant la source dans un HTMLBody, Outlook va comprendre le html et le mail que recevront les destinataires,
'sera à l'identique du fichier Word publiposté
oMail.To = listeContact
oMail.Subject = objet
oMail.HTMLBody = sHtml
oMail.Send