Discussion :

[Eric]

Bonjour,

Je ne suis pas très fort en VB et de ce fait je galère souvent.
Mon executable à pour objectif de piloter un publipostage sous Word suivant les paramètres passés.
Ma particularité est que je souhaite remplacer un caractère par un autre : || par ^p (soit par un retour à la ligne).
Lorsque je suis en mode Publipostage dans un nouveau document, pas de problème car je réalise le traitement après la création
par Word du document contenant les données fusionnées (Cf. ci-après)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
With objdoc.MailMerge
    .OpenDataSource Name:=mergefile, ReadOnly:=True
    Select Case Subject
        Case "1"  ' Publipostage vers nouveau document
            .Destination = wdSendToNewDocument
            .Execute Pause:=False
        Case "2" ' Publipostage via emails
            .Destination = wdSendToEmail
            .MailSubject = Title
            .MailAddressFieldName = Adresse
            .Execute Pause:=True
        Case "3" ' Publipostage via télécopie
            .Destination = wdSendToFax
            .MailAddressFieldName = Adresse
    End Select
End With
 
If Subject = "1" Then
    objdoc.Close SaveChanges:=False
    objapp.ActiveDocument.ActiveWindow.WindowState = wdWindowStateMaximize
    objapp.ActiveDocument.ActiveWindow.Selection.Find.ClearFormatting
    objapp.ActiveDocument.ActiveWindow.Selection.Find.Replacement.ClearFormatting
     With objapp.ActiveDocument.ActiveWindow.Selection.Find
        .Text = "||"
        .Replacement.Text = "^p"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    objapp.ActiveDocument.ActiveWindow.Selection.Find.Execute Replace:=wdReplaceAll
End If

Mon problème est lorsque le document est un mail ou une télécopie, car WORD sur e Execute du wdSendToEmail ou wdSendToFax
réalise pour chacun des enregistrements dans une nouvelle fenêtre qu'il ferme après traitement.
Mon idée est donc d'utiliser l'événement MailMergeAfterRecordMerge ; si je passe bien dans l'évènement pour chacun des enregistrements de mon datasource
je n'arrive pas exprimer mon action correctement.

J'ai essayé pas mal de combinaison et je rencontre toujours un problème suivant la forme de la méthode ci-après

En fait je ne sais pas comment dire que mon find s'adresse au document de fusion qui est en cours (d'ailleurs comme
je suis dans l’événement après fusion de l'enregistrement, il doit bien le connaitre non ?)

Avec la méthode écrite comme cela je n'ai pas d'erreur mais cela ne fait rien et mon texte reste tel quel

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Private Sub objapp_MailMergeAfterRecordMerge(ByVal Doc As document)
 
    Doc.ActiveDocument.ActiveWindow.Selection.Find.ClearFormatting
    Doc.ActiveDocument.ActiveWindow.Selection.Find.Replacement.ClearFormatting
     With Doc.ActiveDocument.ActiveWindow.Selection.Find
        .Text = "||"
        .Replacement.Text = "^p"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Doc.ActiveDocument.ActiveWindow.Selection.Find.Execute Replace:=wdReplaceAll
 
End Sub

Des idées, des pistes ?

Merci d'avance.

[Eric]

Bon en fait là je suis sur le document Word principal et non là ou je pensais être à savoir sur le document résultat de la fusion.
En fait mon problème se situe là, je n'arrive pas à trouver comment formuler que je souhaite adresser l'instance en cours de la fusion.

Personne n'est inspiré ?

[Eric]

Je continue mon monologue...

J'ai un peu avancé en utilisant l'événement MailMergeBeforeRecordMerge et là en modifiant mon code comme suit cela fonctionne
mais uniquement pour le 1er enregistrement alors que l'on devrait passer dans l’événement pour tous les enregistrements du datasource.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
 
 
Dim WithEvents objapp As Application ' En déclaration générale afin d'avoir accès aux événements :
 
Private Sub objapp_MailMergeBeforeRecordMerge(ByVal Doc As document, Cancel As Boolean)
 
    Set TheRange = Doc.Content
    Beep ' Me confirme que l'on ne passe qu'une fois quelque soit le nombre d'enregistrements dans le datasource :-((
    TheRange.Find.Execute FindText:="||", ReplaceWith:="^p", _
    Replace:=wdReplaceAll
    Cancel = False
 
End Sub

Je commence à fatiguer et ne trouve rien comme solution, je ne suis pas le seul à avoir constaté cela mais la solution n'est jamais évoquée...

[Eric]

En fait si je ne fais rien dans l’événement alors j'obtiens bien le nombre attendu de mails, (c'est à dire autant que d'enregistrements dans le datasource).
Idem si je ne met qu'un Beep dans le code à exécuter mais dès que l'on fait autre chose seul le premier enregistrement est traité...

[Eric]

Bon ma conclusion après 2 jours d'errance...
L'utilisation de Find dans l’événement MailMergeBeforeRecordMerge pose problème...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
 
Private Sub objapp_MailMergeBeforeRecordMerge(ByVal Doc As document, Cancel As Boolean)
    MsgBox (ActiveDocument.MailMerge.DataSource.DataFields(5).Value)
End Sub
' Avec le code ci-dessus il y aura bien autant d'affichages que d'enregistrements
 
Private Sub objapp_MailMergeBeforeRecordMerge(ByVal Doc As document, Cancel As Boolean)
    Beep
End Sub
' Avec le code ci-dessus il y aura bien autant de Beep que d'enregistrements
 
Private Sub objapp_MailMergeBeforeRecordMerge(ByVal Doc As document, Cancel As Boolean)
    Set TheRange = Doc.Content
    TheRange.Find.Execute FindText:="||", ReplaceWith:="^p", _
    Replace:=wdReplaceAll, Wrap:=wdFindContinue
End Sub
' Avec le code ci-dessus il y aura un seul passage, (pour le premier enregistrement uniquement). 
' Le remplacement fonctionne et puis le publipostage s'arrête.

[Eric]

J'ai enfin réussi à obtenir ce que je voulais...

Donc afin de contourner le problème de l’événement qui stop le mailing dès que l'on execute un find.

J'ai modifié l’exécution du publipostage comme suit en m'inspirant d'un exemple, (donné pour une autre problématique), de heureuxoli.

Je force une boucle sur le nombre d'enregistrements du datasource (pour les cas 2 et 3) et je ne laisse pas filer en automatique comme pour le cas 1.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
Set ObjDoc = ObjApp.Documents.Open(Document) ' Ouverture du document principal de fusion
On Error GoTo erreur3
ObjDoc.MailMerge.OpenDataSource Name:=Mergefile, ReadOnly:=True ' Ouverture du fichier de données
    ' ----
Select Case Subject
    ' ------------------------------------------
    Case "1" ' Vers nouveau document
    ' ------------------------------------------
    With ObjDoc.MailMerge
        .Destination = wdSendToNewDocument
        .Execute Pause:=False
    End With
    ' ----
    ObjDoc.Close SaveChanges:=False ' Fermeture du document principal (on ne conserve ici que le document résultat du publipostage)
    ' ----
    ObjApp.ActiveDocument.ActiveWindow.WindowState = wdWindowStateMaximize '  On remplace les caractères souhaités sur le document résultat
    ObjApp.ActiveDocument.ActiveWindow.Selection.Find.ClearFormatting
    ObjApp.ActiveDocument.ActiveWindow.Selection.Find.Replacement.ClearFormatting
    With ObjApp.ActiveDocument.ActiveWindow.Selection.Find
        .Text = "||"
        .Replacement.Text = "^p"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    ObjApp.ActiveDocument.ActiveWindow.Selection.Find.Execute Replace:=wdReplaceAll
    ' ----
    With ObjApp.ActiveDocument.ActiveWindow.Selection.Find
        .Text = "0:00:00"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    ObjApp.ActiveDocument.ActiveWindow.Selection.Find.Execute Replace:=wdReplaceAll
    ' ------------------------------------------
    Case "2"
    ' ------------------------------------------
    ObjDoc.MailMerge.DataSource.ActiveRecord = wdLastRecord
    iMax = ObjDoc.MailMerge.DataSource.ActiveRecord
    For i = 1 To iMax 
        With ObjDoc.MailMerge
            .DataSource.FirstRecord = i ' Définition du premier et dernier enregistrement
            .DataSource.LastRecord = i
            .Destination = wdSendToEmail
            .MailSubject = Title
            .MailAddressFieldName = Adresse
            .SuppressBlankLines = True
            .Execute
            .DataSource.ActiveRecord = i
        End With
    Next i
    ' ------------------------------------------
    Case "3"
    ' ------------------------------------------
    With ObjDoc.MailMerge
        .Destination = wdSendToFax
        .MailAddressFieldName = Adresse
        .SuppressBlankLines = True
    End With
 
    ObjDoc.MailMerge.DataSource.ActiveRecord = wdLastRecord
    iMax = ObjDoc.MailMerge.DataSource.ActiveRecord
    For i = 1 To iMax ' iMax
        With ObjDoc.MailMerge
            .DataSource.FirstRecord = i
            .DataSource.LastRecord = i
            .Destination = wdSendToFax
            .MailAddressFieldName = Adresse
            .SuppressBlankLines = True
            .Execute
            .DataSource.ActiveRecord = i
        End With
    Next i
End Select
End

Pour les cas 2 et 3 qui posaient problème le find est exécuté dans l’événement ci-après

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Private Sub objapp_MailMergeBeforeRecordMerge(ByVal Doc As Document, Cancel As Boolean)
If (Subject > 1) Then
  Doc.Content.Find.Execute FindText:="||", ReplaceWith:="^p", _
  Replace:=wdReplaceAll, Wrap:=wdFindContinue
  Cancel = False
End If
End Sub