Publipostage VBA marche qu'une fois ..

Fermé
eljojo_e Messages postés 1151 Date d'inscription lundi 10 mai 2010 Statut Membre Dernière intervention 14 octobre 2022 - 29 mars 2013 à 09:21
Bonjour,

sous access, j'ai un code vba qui me permet d'ouvrir un modèle word, et lance un publipostage : voir codes ci dessous

Cependant, le code pour ouvrir le fichier word marche tout le temps, mais le code pour faire le publipostage se lance une seul fois et après ne fonctionne plus. Dès que je redémarre access, le code refonctoinne une seul fois.


Des idées ????

Cordialement,



Code access :
Private Sub CmdGenerateur_Click()
On Error GoTo er:
a = Me.ModeleG.Value

   DoCmd.Close
 
Dim wdapp As Word.Application

'Démarrer Word
Set wdapp = CreateObject("Word.application")
With wdapp
       .Visible = True

      'ouvrir le document
      .Documents.Open "Y:\URBANISME\AA REPONSES AUX COMMUNES\000-Modèles\" & a
      .Activate
      
End With

'fermer et libérer les objets
Set wdapp = Nothing

Word.Application.Run MacroName:="Urba"
GoTo Fin:
er:

Fin:
End Sub


le "Word.Application.Run MacroName:="Urba"" lance un code vba dans word pour faire le publipostage :


Sub urba()
'
' Macro2 Macro
'
'
    ActiveDocument.MailMerge.MainDocumentType = wdFormLetters
    ActiveDocument.MailMerge.OpenDataSource Name:= _
        "Y:\SERVICES TECHNIQUES\SI\GTI\GTI Source.mdb", _
        ConfirmConversions:=False, ReadOnly:=False, LinkToSource:=True, _
        AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", _
        WritePasswordDocument:="", WritePasswordTemplate:="", Revert:=False, _
        Format:=wdOpenFormatAuto, Connection:= _
        "Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=Y:\SERVICES TECHNIQUES\SI\GTI\GTI Source.mdb;Mode=Read;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Engine Type=5;Jet OLEDB:Database Locki" _
        , SQLStatement:="SELECT * FROM 'T PUBLIPOSTAGE URBA'", SQLStatement1:="", _
         SubType:=wdMergeSubTypeAccess
    ActiveDocument.MailMerge.DataSource.ActiveRecord = wdNextRecord
    a = ActiveDocument.Name
    With ActiveDocument.MailMerge
        .Destination = wdSendToNewDocument
        .SuppressBlankLines = True
        With .DataSource
            .FirstRecord = ActiveDocument.MailMerge.DataSource.ActiveRecord
            .LastRecord = ActiveDocument.MailMerge.DataSource.ActiveRecord
        End With
        .Execute Pause:=False
    End With
    Documents(a).Activate
    ActiveWindow.Close
End Sub