Discussion :

[arverne63]

Bonjour,

Depuis ce matin j'ai un souci avec le code ci dessous.
Jusqu'à hier tout fonctionnait mais maintenant quand j’exécute le code il se lance et je vois apparaître 23 fichiers temporaire sur 173 dans l' explorateur windows, puis le processus s’arrête avec un message "erreur d’exécution 3021" à la ligne 30.
J'ai fais un essai sur une autre base qui n'a pas les mêmes données et j'ai cette même erreur avant la fin.
Si quelqu'un à une solution, je suis preneur.
Merci

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
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
Option Compare Database

Sub Poste()
    Dim wApp As Word.Application
    Dim wDoc As Word.Document
    Dim chemin As String
    Dim sqlA As String, sqlS As String, sqlB As String
    Dim rsA As DAO.Recordset, rsS As DAO.Recordset, rsB As DAO.Recordset
    Dim db As DAO.Database
    Set db = CurrentDb
    sqlA = "SELECT * FROM R_Publipostage_Adherents"
    Set rsA = db.OpenRecordset(sqlA)
    Set wApp = New Word.Application
   ' wApp.Visible = True
    chemin = CurrentProject.Path
 
    While Not rsA.EOF
    Set wDoc = wApp.Documents.Open(chemin & "\Modele_publipostage.docx")
 
        wDoc.Bookmarks("civilite").Range.Text = rsA.Fields("civilite")
        wDoc.Bookmarks("nom").Range.Text = UCase(rsA.Fields("nom_adhe"))
        wDoc.Bookmarks("prenom").Range.Text = rsA.Fields("prenom")
        wDoc.Bookmarks("adresse").Range.Text = rsA.Fields("adresse")
        wDoc.Bookmarks("codePostal").Range.Text = rsA.Fields("code_postal")
        wDoc.Bookmarks("Ville").Range.Text = UCase(rsA.Fields("ville"))
        wDoc.Bookmarks("Prenom1").Range.Text = rsA.Fields("Prenom")
 
        sqlB = "SELECT * FROM R_Publipostage_NombrePR WHERE numero=" & rsA.Fields("numero")
        Set rsB = db.OpenRecordset(sqlB)
        wDoc.Bookmarks("NbCircuits").Range.Text = rsB.Fields("total")
 
        '--- tableau
        sqlS = "SELECT * FROM R_Publipostage_Circuits WHERE numero_adhe=" & rsA.Fields("numero")
        Set rsS = db.OpenRecordset(sqlS)
 
            While Not rsS.EOF
                wDoc.Tables(1).Rows.Add
                wDoc.Tables(1).Rows.Last.Cells(1).Range.Text = rsS.Fields("secteur_balirando")
                wDoc.Tables(1).Rows.Last.Cells(2).Range.Text = UCase(rsS.Fields("Code"))
                wDoc.Tables(1).Rows.Last.Cells(3).Range.Text = rsS.Fields("nom-pr")
                wDoc.Tables(1).Rows.Last.Cells(4).Range.Text = UCase(rsS.Fields("depart"))
                wDoc.Tables(1).Rows.Last.Cells(5).Range.Text = rsS.Fields("balisage")
                rsS.MoveNext
            Wend
    'sauvegarde du fichier
    wDoc.SaveAs CurrentProject.Path & "\Temp" & Format(Date, "yyyy_mm_dd") & "_" & rsA.Fields("numero") & ".docx"
    wDoc.Close (wdDoNotSaveChanges)
        rsA.MoveNext
    Wend
 
    rsS.Close:  Set rsS = Nothing
    rsA.Close:  Set rsA = Nothing
    db.Close:   Set db = Nothing
    wApp.Quit
    Set wApp = Nothing
    Dim wDoc1 As Object

Dim stFicDocs As String
Dim stRepDocs As String
Set wApp = CreateObject("Word.Application")
stRepDocs = (CurrentProject.Path)
 
'wApp.Visible = True
wApp.Documents.Add
Set wDoc1 = wApp.Documents(1)
' définition des marges
wDoc1.PageSetup.BottomMargin = 39.7
wDoc1.PageSetup.LeftMargin = 42.55
wDoc1.PageSetup.RightMargin = 70.9
wDoc1.PageSetup.TopMargin = 28.35
 
stRepDocs = CurrentProject.Path
' lecture du répertoire contenant les documents
ChDir stRepDocs
stFicDocs = Dir(stRepDocs & "\Temp" & Format(Date, "yyyy_mm_dd") & "*.docx")
 
While stFicDocs <> ""
    With wApp.Selection
        .InsertFile FileName:=stRepDocs & "\" & stFicDocs, ConfirmConversions:=False
        .InsertBreak Type:=wdSectionBreakNextPage
        .Collapse Direction:=wdCollapseEnd
    End With
    stFicDocs = Dir()
Wend
 
'changer le format intervalle des paragraphes du document
wApp.Selection.WholeStory
With wApp.Selection.ParagraphFormat
     .SpaceBeforeAuto = False
     .SpaceAfter = 0
     .SpaceAfterAuto = False
     .LineSpacingRule = wdLineSpaceSingle
     .LineUnitAfter = 0
End With
 
' sauvegarde du fichier définitif et quitte Word
wDoc1.SaveAs stRepDocs & "\Publipostage " & ".docx"
wDoc1.Close (wdSaveChanges)
wApp.Quit
 
' destruction des fichiers temporaires
Dim oFso As Object
Set oFso = CreateObject("Scripting.FileSystemObject")
oFso.deletefile stRepDocs & "\Temp" & Format(Date, "yyyy_mm_dd") & "*.docx"
Set oFso = Nothing


End Sub

[tee_grandbois]

bonsoir,
erreur 3021 aucun enregistrement en cours, c'est clair comme message, il faut donc tester si on est en fin de fichier:

Code :

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

if Not rsB.EOF Then wDoc.Bookmarks("NbCircuits").Range.Text = rsB.Fields("total")

[arverne63]

bonsoir,
erreur 3021 aucun enregistrement en cours, c'est clair comme message, il faut donc tester si on est en fin de fichier:

Code :

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

if Not rsB.EOF Then wDoc.Bookmarks("NbCircuits").Range.Text = rsB.Fields("total")

Bonjour,

Encore merci, maintenant ça marche avec ce code.
Mais je ne comprend pas pourquoi le 1er code a fonctionné ?

Bon dimanche.

Code :

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

1
2
3
4
    sqlB = "SELECT * FROM R_Publipostage_NombrePR WHERE numero=" & rsA.Fields("numero")
        Set rsB = db.OpenRecordset(sqlB)
        If Not rsB.EOF Then wDoc.Bookmarks("NbCircuits").Range.Text = rsB.Fields("total")
        'wDoc.Bookmarks("NbCircuits").Range.Text = rsB.Fields("total")

[tee_grandbois]

Mais je ne comprend pas pourquoi le 1er code a fonctionné ?

il fonctionne tant qu'il y a un enregistrement, c'est quand il n'y en a pas que ça plante ...

[arverne63]

il fonctionne tant qu'il y a un enregistrement, c'est quand il n'y en a pas que ça plante ...

Ok

Merci.