Dim x As New EventClassModule
Public mois_fr As String
Public mois_eng As String
Sub publipostage()
If MsgBox("veuillez vous assurer que la macro est présente dans Outlook", vbYesNo + vbExclamation) = vbNo Then Exit Sub
EnableEventHandler
question1:
datenum = InputBox("Quelle est la date au format numérique ?", "date format numérique")
If datenum = "" Then
MsgBox ("Annulation")
Exit Sub
End If
question2:
mois_fr = InputBox("Quel est le mois en Francais suivi de la date numérique ?", "mois Fr")
If mois_fr = "" Then
MsgBox ("annulation, retour à la première question")
GoTo question1
End If
mois_eng = InputBox("Quel est le mois en Anglais suivi de la date numérique ?", "mois En")
If mois_eng = "" Then
MsgBox ("annulation, retour à la première question")
GoTo question2
End If
Selection.MoveDown Unit:=wdLine, Count:=17
Selection.MoveRight Unit:=wdCharacter, Count:=3
Selection.TypeText Text:=datenum
Selection.MoveDown Unit:=wdLine, Count:=3
Selection.MoveRight Unit:=wdCharacter, Count:=21
Selection.TypeText Text:=datenum
Selection.MoveDown Unit:=wdLine, Count:=3
Selection.MoveLeft Unit:=wdCharacter, Count:=2
Selection.TypeText Text:=mois_eng
Selection.MoveDown Unit:=wdLine, Count:=21
ActiveDocument.MailMerge.Fields.Add Range:=Selection.Range, Name:= _
"CONTACT_1"
With ActiveDocument.MailMerge
.MailAddressFieldName = "CONTACT_1"
.Destination = wdSendToEmail
.SuppressBlankLines = True
With .DataSource
.FirstRecord = wdDefaultFirstRecord
.LastRecord = wdDefaultLastRecord
End With
.Execute Pause:=False
End With
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
ActiveDocument.MailMerge.Fields.Add Range:=Selection.Range, Name:= _
"CONTACT_2"
With ActiveDocument.MailMerge
.MailAddressFieldName = "CONTACT_2"
.Destination = wdSendToEmail
.SuppressBlankLines = True
With .DataSource
.FirstRecord = wdDefaultFirstRecord
.LastRecord = wdDefaultLastRecord
End With
.Execute Pause:=False
End With
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
ActiveDocument.MailMerge.Fields.Add Range:=Selection.Range, Name:= _
"CONTACT_3"
With ActiveDocument.MailMerge
.MailAddressFieldName = "CONTACT_3"
.Destination = wdSendToEmail
.SuppressBlankLines = True
With .DataSource
.FirstRecord = wdDefaultFirstRecord
.LastRecord = wdDefaultLastRecord
End With
.Execute Pause:=False
End With
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
ActiveDocument.MailMerge.Fields.Add Range:=Selection.Range, Name:= _
"CONTACT_4"
With ActiveDocument.MailMerge
.MailAddressFieldName = "CONTACT_4"
.Destination = wdSendToEmail
.SuppressBlankLines = True
With .DataSource
.FirstRecord = wdDefaultFirstRecord
.LastRecord = wdDefaultLastRecord
End With
.Execute Pause:=False
End With
DisableEventHandler
End Sub
Sub EnableEventHandler()
Set x.App = Word.Application
End Sub
Sub DisableEventHandler()
Set x.App = Nothing
End Sub