Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

VBA Access Discussion :

Publipostage à l'aide de Recordsets et de signets


Sujet :

VBA Access

  1. #1
    Membre du Club
    Publipostage à l'aide de Recordsets et de signets
    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

  2. #2
    Expert éminent sénior
    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")
    Quand on est derrière l'écran on n'a aucun clavier sous les mains ...

  3. #3
    Membre du Club
    Citation Envoyé par tee_grandbois Voir le message
    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")

  4. #4
    Expert éminent sénior
    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 ...
    Quand on est derrière l'écran on n'a aucun clavier sous les mains ...

  5. #5
    Membre du Club
    Citation Envoyé par tee_grandbois Voir le message
    il fonctionne tant qu'il y a un enregistrement, c'est quand il n'y en a pas que ça plante ...
    Ok

    Merci.

###raw>template_hook.ano_emploi###