Erreur de compilation sur VBA envoi de mail publipostage

Le 16/09/2020 à 11:37

Bonjour,

Je travaille sur un petit dans lequel je voudrais faire un publipostage avec un fichier Excel comme base de données et un fichier Word à publiposter, transormer au format PDF et envoyer au différents destinataires. Le problème, c'est que je bute sur une erreur que je ne comprends pas.

erreur

Besoin de votre aide.

Mon code ci-dessous

Sub FusionEnregSuiv()
'
' FusionEnregSuiv Macro

'
    ActiveDocument.MailMerge.DataSource.ActiveRecord = wdNextRecord

'
' FusionEnregPrem Macro

'
    ActiveDocument.MailMerge.DataSource.ActiveRecord = wdFirstRecord

'
' FusionDernEnreg Macro

'
    ActiveDocument.MailMerge.DataSource.ActiveRecord = wdLastRecord

'
' FusionEnregPréc Macro

'
    ActiveDocument.MailMerge.DataSource.ActiveRecord = wdPreviousRecord

'

Dim fusion As MailMerge
Dim x As Integer, nb As Integer
Dim chemin As String, nom As String, titre As String, espace As String
titre = "BSI"
espace = " "
Set fusion = ActiveDocument.MailMerge
chemin = "C:\Users\bc00T349\\Desktop\PDF\"  'mettre ici le chemin complet du dossier où stocker les fichiers sans oublier le \ à la fin
nb = fusion.DataSource.RecordCount
For x = 0 To nb - 1
With fusion
    .DataSource.FirstRecord = x + 1
    .DataSource.LastRecord = x + 1
    .Destination = wdSendToNewDocument
    .DataSource.ActiveRecord = x + 1
    nom = .DataSource.DataFields("nom") 'Remplacer nom par le champ à utiliser
    .Execute
End With
'ActiveDocument.ExportAsFixedFormat OutputFileName:=chemin & titre & espace & nom & ".pdf", ExportFormat:=wdExportFormatPDF, openafterexport:=False
ActiveDocument.ExportAsFixedFormat OutputFileName:=chemin & nom & ".pdf", ExportFormat:=wdExportFormatPDF, openafterexport:=False
ActiveDocument.Close savechanges:=False

Next

' Nécessite la référence : Microsoft Outlook 1x Object Library
Dim outApp As Outlook.Application
Dim oItem As Outlook.MailItem
Dim leSujet As String, leDestinataire As String, pieceJointe As String
Dim i As Integer
Dim cell As Range

Set outApp = CreateObject("Outlook.Application")

leSujet = "Bilan Social Individuel (BSI) 2020"

'Afficher le 1er enregistrement du publipostage
ActiveDocument.MailMerge.DataSource.ActiveRecord = wdFirstRecord

'boucle sur tous les enregistrements de la base de données
For i = 1 To ActiveDocument.MailMerge.DataSource.RecordCount
'récupération des adresses mail qui sont dans le champ "champMail"
leDestinataire = ThisDocument.MailMerge.DataSource.DataFields("Email").Value

Set oItem = outApp.CreateItem(olMailItem)
'Application.DisplayAlerts = wdAlertsNone

With oItem
.Subject = leSujet
.Body = ThisDocument.Content 'insère le contenu du document dans le corps du message
.Body = "Bonjour " & Cells(cell.Row, "B").Value _
                      & vbNewLine & vbNewLine & _
                        "Veuillez trouvez ci-joint, votre Bilan Social Individuel 2020. " & _
                    vbNewLine & vbNewLine & _
                        "Bonne réception. Cordialement!."
.To = leDestinataire
'ajout d'un fichier attaché

.Attachments.Add ("C:\Users\bc00T349\Desktop\PDF\" & Cells(cell.Row, "B").Value & ".pdf")
.Send 'envoi du mail
End With

'pour passer à l'enregistrement suivant
ThisDocument.MailMerge.DataSource.ActiveRecord = wdNextRecord
Set oItem = Nothing
Next i

Set outApp = Nothing

End Sub
Le 16/09/2020 à 11:59

bonjour,

une proposition (non testée) sur base de mon interprétation des infos que tu as bien voulu mettre

Sub FusionEnregSuiv()
'
' FusionEnregSuiv Macro

'
    ActiveDocument.MailMerge.DataSource.ActiveRecord = wdNextRecord

'
' FusionEnregPrem Macro

'
    ActiveDocument.MailMerge.DataSource.ActiveRecord = wdFirstRecord

'
' FusionDernEnreg Macro

'
    ActiveDocument.MailMerge.DataSource.ActiveRecord = wdLastRecord

'
' FusionEnregPréc Macro

'
    ActiveDocument.MailMerge.DataSource.ActiveRecord = wdPreviousRecord

'

Dim fusion As MailMerge
Dim x As Integer, nb As Integer
Dim chemin As String, nom As String, titre As String, espace As String
titre = "BSI"
espace = " "
Set fusion = ActiveDocument.MailMerge
chemin = "C:\Users\bc00T349\\Desktop\PDF\"  'mettre ici le chemin complet du dossier où stocker les fichiers sans oublier le \ à la fin
nb = fusion.DataSource.RecordCount
For x = 0 To nb - 1
With fusion
    .DataSource.FirstRecord = x + 1
    .DataSource.LastRecord = x + 1
    .Destination = wdSendToNewDocument
    .DataSource.ActiveRecord = x + 1
    nom = .DataSource.DataFields("nom") 'Remplacer nom par le champ à utiliser
    .Execute
End With
'ActiveDocument.ExportAsFixedFormat OutputFileName:=chemin & titre & espace & nom & ".pdf", ExportFormat:=wdExportFormatPDF, openafterexport:=False
ActiveDocument.ExportAsFixedFormat OutputFileName:=chemin & nom & ".pdf", ExportFormat:=wdExportFormatPDF, openafterexport:=False
ActiveDocument.Close savechanges:=False

Next

' Nécessite la référence : Microsoft Outlook 1x Object Library
Dim outApp As Outlook.Application
Dim oItem As Outlook.MailItem
Dim leSujet As String, leDestinataire As String, pieceJointe As String
Dim i As Integer
Dim cell As Range

Set outApp = CreateObject("Outlook.Application")

leSujet = "Bilan Social Individuel (BSI) 2020"

'Afficher le 1er enregistrement du publipostage
ActiveDocument.MailMerge.DataSource.ActiveRecord = wdFirstRecord

'boucle sur tous les enregistrements de la base de données
For i = 1 To ActiveDocument.MailMerge.DataSource.RecordCount
'récupération des adresses mail qui sont dans le champ "champMail"
leDestinataire = ThisDocument.MailMerge.DataSource.DataFields("Email").Value
nom = ThisDocument.MailMerge.DataSource.DataFields("nom")
Set oItem = outApp.CreateItem(olMailItem)
'Application.DisplayAlerts = wdAlertsNone

With oItem
.Subject = leSujet
.Body = ThisDocument.Content 'insère le contenu du document dans le corps du message
.Body = "Bonjour " & nom _
                      & vbNewLine & vbNewLine & _
                        "Veuillez trouvez ci-joint, votre Bilan Social Individuel 2020. " & _
                    vbNewLine & vbNewLine & _
                        "Bonne réception. Cordialement!."
.To = leDestinataire
'ajout d'un fichier attaché

.Attachments.Add ("C:\Users\bc00T349\Desktop\PDF\" & nom & ".pdf")
.Send 'envoi du mail
End With

'pour passer à l'enregistrement suivant
ThisDocument.MailMerge.DataSource.ActiveRecord = wdNextRecord
Set oItem = Nothing
Next i

Set outApp = Nothing

End Sub
Le 16/09/2020 à 12:11

Bonjour h2so4,

Merci beaucoup, ça fonctionne à merveille. Génie, Génie, Génie

Excellente journée à vous!

Rechercher des sujets similaires à "erreur compilation vba envoi mail publipostage"