[AC-2010] Publipostage vers word d'une requète dépendant d'un formulaire [Résolu]

[xenosender]

Bonjour

Je souhaite publiposter les résultats d'une requète complexe RQ3 construite comme suit :

RQ1 dépend des valeurs du formulaire F pour réaliser diverses jointures
RQ2 dépend des résultats de RQ1 et des valeurs de F pour d'autres jointures
RQ3 fait un tri sur RQ2 à partir d'autres valeurs de F

(je n'ai pas fait la base, je précise...)
Tout cela pour dire que RQ3 a besoin que certain champs de F soient remplies avant d'être lancée.

Or il semble que le publipostage word gère très mal les requêtes à paramêtres, car elle lance une nouvelle instance d'access dans laquelle le formulaire n'est (évidemment) pas rempli.
Il faut donc (semble-t-il) développer une macro pour gérer ce publipostage.

Mon problème :
- je sais récupérer les valeurs de mon formulaire, mais y a t'il moyen de les réinjecter dans le formulaire de la nouvelle instance ?
- autre piste, est il possible de coder "en dur" la requete SQL (i.e. remplacer les expressions [Forms]![mon_form]![mon_champs] par leurs valeurs), ce qui règlerait le problème de la dépendance au formulaire ?
Evidemment, contrainte supplémentaire, chaque requete SQL que j'ai mentionnée fait bien plus que 255 caractères...

Bref, comment gérer ce publipostage ?

Mon code jusqu'à maintenant :

Code :

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
 
Private Sub Commande65_Click()
 
    Const DOC_WORD = "C:\path\to\mon_fichier.doc"
 
    'récupération de valeur de formulaire
    Dim PREPA As String
    PREPA = [Forms]![Sélection Etat Des Courriers Elèves]![Prépa].Value
 
    'récupération de requete SQL RQ3
    Dim qdf As DAO.QueryDef
    Dim rcs As DAO.Recordset
    Dim myquery As String
 
    Set qdf = CurrentDb.QueryDefs("RQ Sélection Etat des Courriers Elèves Sans Matières")
     myquery = qdf.SQL
    'ici, myquery est trop courte et une bonne partie de la requete est perdue
 
    'ouverture de word
    Dim wdApp As Word.Application
    Set wdApp = CreateObject("Word.application")
    With wdApp
        ' Word est visible pendant les tests
        .Visible = True
 
        ' Ouvrir la lettre type
        .Documents.Open DOC_WORD
 
        ' Lier la lettre type à la source de données Access
        .ActiveDocument.MailMerge.OpenDataSource _
        Name:=CurrentProject.FullName, _
 
        'que mettre ici?
        SQLStatement:="SELECT * FROM [Sélection des Courriers Elèves.SelectCourrier]"
 
        ' La fusion doit se faire dans un nouveau document
        .ActiveDocument.MailMerge.Destination = wdSendToNewDocument
 
        ' Exécuter la fusion
        .ActiveDocument.MailMerge.Execute
    End With
 
End Sub

[xenosender]

Bon, j'ai contourné mon problème en créant une table temporaire pour y mettre les résultats de la requete, et je lance le publipostage sur la table temporaire.
Une fois le document word fermé, je supprime la table temporaire.

Code :

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
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
 
Function LauchFusionWithWord(myQueryName As String)
'Lauch the fusion with word from the results of the query myQueryName
'It prompts for the file to open, puts the results in a temporary table and
'use the table as base for the fusion
 
''Open Dialog
    Dim FileName As String    'full file name
 
    'returns your full file name.
    FileName = FindWordFile()
 
    'hence no len, no name...
    If Len(FileName) = 0 Then Exit Function
 
    '' Creation of the Table
    DoCmd.SetWarnings False
 
    On Error Resume Next
    DoCmd.RunSQL ("DROP TABLE Temp_publipostage_table")
 
    On Error GoTo TableErrHandler:
    DoCmd.RunSQL ("SELECT * INTO Temp_publipostage_table FROM [" & myQueryName & "]")
    DoCmd.SetWarnings True
 
 
    '' Launching the fusion
    Dim wdApp As Word.Application
    Dim wdAppl As String
 
    Set wdApp = CreateObject("Word.application")
    wdAppl = "Word.application"
    With wdApp
        ' Word est visible pendant les tests
        .Visible = True
 
        ' Ouvrir la lettre type
        .Documents.Open FileName
 
        ' Lier la lettre type à la source de données Access
        .ActiveDocument.MailMerge.OpenDataSource _
                            Name:=CurrentProject.FullName, _
                            LinkToSource:=True, _
                            Connection:="TABLE Temp_publipostage_table", _
                            SQLStatement:="SELECT * FROM [Temp_publipostage_table]"
 
        ' Exécuter la fusion
        .ActiveDocument.MailMerge.Execute
    End With
 
    'Attendre que le fichier word se ferme
    Do While IsFileLocked(FileName)
        PauseAccess (1)
    Loop
 
    Set wdApp = Nothing
 
    'On supprime la table temporaire
    DoCmd.SetWarnings False
    On Error Resume Next
    DoCmd.RunSQL ("DROP TABLE Temp_publipostage_table")
    DoCmd.SetWarnings True
 
    Exit Function
 
TableErrHandler:
    'error in creating the table
    DoCmd.SetWarnings True
    MsgBox "Une erreur s'est produite à la récupération des enregistrements, Publipostage annulé", vbCritical
 
 
    Exit Function
 
End Function
 
Function IsFileLocked(sFile As String) As Boolean
'check is a file is opened by another process
    On Error Resume Next
 
     ' \\ Open the file
    Open sFile For Binary Access Read Write Lock Read Write As #1
     ' \\ Close the file
    Close #1
 
     ' \\ If error occurs the document if open!
    If Err.Number <> 0 Then
         '\\ Return true and clear error
        IsFileLocked = True
        Err.Clear
    End If
End Function
 
Public Function PauseAccess(NumberOfSeconds As Variant)
'Makes Access wait for a specific time
 
On Error GoTo Err_Pause
 
    Dim PauseTime As Variant, start As Variant
 
    PauseTime = NumberOfSeconds
    start = Timer
    Do While Timer < start + PauseTime
    DoEvents
    Loop
 
Exit_Pause:
    Exit Function
 
Err_Pause:
    MsgBox Err.Number & " - " & Err.Description, vbCritical, "Pause()"
    Resume Exit_Pause
 
End Function