Discussion :

[Nanoucha]

Bonjour,

Je fais du publipostage entre Word et Access 2003 à l'aide la programmation vba et j'ai un bug lorsque j'essaie de diriger le publipostage vers un nouveau document Word. C'est la première fois que je fais du publipostage entre Word et Access!

J'ai créée un document Word principal en liant où j'ai spécifié la source de données (requête reqUsager se trouvant dans ma BD Access 2003). À chaque fois que j'arrive à cette ligne dans mon code
' Diriger le publispotage vers un nouveau document
.ActiveDocument.MailMerge.Destination = wdSendToNewDocument
j'ai une erreur qui est la suivante:
"Erreur d'exécution '5852' : L'objet demandé n'est pas disponible".
Merci de votre aide

Voici mon code:

Module Pubilpostage :

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
 
 
Function Publipostage_Usager()
Dim wApp As Word.Application
 
' Démarrer Word
Set wApp = CreateObject("Word.Application")
 
With wApp
    .Visible = True
 
    ' Ouvrir l'étiquette
    .Documents.Open ("C:\Publipostage\publipostage.doc")
 
 
    ' Diriger le publispotage vers un nouveau document
    .ActiveDocument.MailMerge.Destination = wdSendToNewDocument
 
    'Supprimer les lignes blanches
'    .ActiveDocument.MailMerge.SuppressBlankLines = True
 
    ' Lancer la fusion
    .ActiveDocument.MailMerge.Execute
End With
 
' Fermer et libérer les objets
Set wApp = Nothing
End Function
 
Function Parametrage_Requete(ByVal strUsagerID As Integer)
Dim qdf As DAO.QueryDef
Dim strSQL As String
Dim intPosition As String
 
' Lire la définition SQL de la requête de publipostage
Set qdf = CurrentDb.QueryDefs("reqUsager")
strSQL = qdf.sql
 
' Chercher le mot WHERE dans le code SQL et supprimer ce qui suit
intPosition = InStr(1, strSQL, "WHERE", vbTextCompare)
If intPosition > 0 Then
    strSQL = Left(strSQL, intPosition - 1)
 
    ' Ajouter une nouvelle condition
    ' (les noms de tables sont facultatifs puisqu'il
    ' n'y a pas ambiguïté)
    strSQL = strSQL & " WHERE [UsagerID] =" & strUsagerID
 
    ' Modifier la requête d'origine
    qdf.sql = strSQL
End If
Set qdf = Nothing
End Function

Formulaire frmUsager :

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
 
Private Sub cmdAdresse_Click()
 Dim strCritere As String
 
' Construire le critère en fonction de la sélection
strCritere = ""
 
If strCritere <> "" Then 
   strCritere = strCritere & " OR " strCritere = strCritere & [UsagerID] 
 
' Modifier la requête et lancer le publipostage
If strCritere <> "" Then
    Parametrage_Requete strCritere
 
    ' Vérifier si la requête n'est pas vide
    If DCount("*", "reqUsager") = 0 Then
        MsgBox "Aucun usager ne répond à vos critères.", vbInformation
    Else
        Publipostage_Usager
    End If
End If
End Sub