"Erreur d'exécution 462" à la deuxième application d'une macro

Lexie

XLDnaute Nouveau
Bonjour,

J'ai créé une macro sur Excel qui me permet de générer automatiquement deux documents Word et qui les enregistre à leur place sur le serveur. Lorsque je clique une première fois sur "générer les documents", je n'ai aucun souci et tout se passe bien : mon attestation et ma convention sont créées sur Word et enregistrées chacune à leur emplacement puis Word se ferme. Mais quand je clique une seconde fois sur le bouton "générer les documents", j'ai un message d'erreur qui apparaît : "Erreur d'exécution 462, le serveur distant n'existe pas ou n'est pas disponible".

Voici mon code, et en rouge ce qu'Excel me surligne en jaune quand je clique sur "débogage" :

Code:
Sub publi_convention_attestation()
'Nécessite d'activer la référence "Microsoft Word xx.x Object Library"
    Dim docWord As Word.Document
    Dim appWord As Word.Application
    Dim NomBase As String
    Dim convention As Variant
        Set convention = Sheets("Publipostage attestation")
    Dim nom As Variant
        nom = Sheets("Base à remplir").Range("C18").Value
    Dim module As Variant
        module = Sheets("Base à remplir").Range("C12").Value
        
    'Chemin = activeworksheets
    NomBase = "J:\Formation\Publipostages\Matrice RB.xlsm"
    
    Application.ScreenUpdating = False
    Set appWord = New Word.Application
    appWord.Visible = True
    'Ouverture du document principal Word
    Set docWord = appWord.Documents.Open("J:\Formation\Publipostages\Attestation RB - modèle.doc")
    nom = Sheets("Base à remplir").Range("C18").Value
    
    
    'fonctionnalité de publipostage pour le document spécifié
    With docWord.MailMerge
        'Ouvre la base de données
        .OpenDataSource Name:=NomBase, _
            SQLStatement:="SELECT * FROM [Publipostage attestation$]"
            'Spécifie la fusion
        .Destination = wdSendToNewDocument
        .SuppressBlankLines = True
        
    'Prend en compte l'ensemble des enregistrements
            With .DataSource
                .FirstRecord = wdDefaultFirstRecord
                .LastRecord = wdDefaultLastRecord
            End With
    
        'Exécute l'opération de publipostage
        .Execute Pause:=False
    End With

Code:
'Sauvegarde le fichier sous un nom particulier'
        ActiveDocument.SaveAs Filename:= _
        "J:\Formation\ATTESTATIONS\Attestation " & module & " - " & nom & ".doc" _
        , FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", _
        AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
        EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
        :=False, SaveAsAOCELetter:=False
Code:
  'ActiveWindow.Close
        
     Application.ScreenUpdating = True
     
     'Fermeture du document Word
    docWord.Close False
    Set docWord = Nothing 'rajouté'
   
    'Ouverture du document principal Word
    Set docWord = appWord.Documents.Open("J:\Formation\Publipostages\Convention RB - modèle.doc")
    nom = Sheets("Base à remplir").Range("C18").Value
        
    'fonctionnalité de publipostage pour le document spécifié
    With docWord.MailMerge
        'Ouvre la base de données
        .OpenDataSource Name:=NomBase, _
            SQLStatement:="SELECT * FROM [Publipostage Conventions$]"
            'Spécifie la fusion
        .Destination = wdSendToNewDocument
        .SuppressBlankLines = True
        
    'Prend en compte l'ensemble des enregistrements
            With .DataSource
                .FirstRecord = wdDefaultFirstRecord
                .LastRecord = wdDefaultLastRecord
            End With
    
        'Exécute l'opération de publipostage
        .Execute Pause:=False
    End With
    
    'Sauvegarde le fichier sous un nom particulier'
        ActiveDocument.SaveAs Filename:= _
        "J:\Formation\CONVENTIONS\Convention " & module & " - " & nom & ".doc" _
        , FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", _
        AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
        EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
        :=False, SaveAsAOCELetter:=False
        'ActiveWindow.Close
        
     Application.ScreenUpdating = True
     
    'Fermeture du document Word
    docWord.Close False
    Set docWord = Nothing 'rajouté"
    appWord.Quit
    Set appWord = Nothing 'rajouté'
End Sub

Je ne vois pas du tout où je pourrais changer le code pour que ça fonctionne "à l'infini"...
 

PMO2

XLDnaute Accro
Re : "Erreur d'exécution 462" à la deuxième application d'une macro

Bonjour,

Peut être comme cela
Code:
'Sauvegarde le fichier sous un nom particulier'
        docWord.SaveAs Filename:= _
        "J:\Formation\ATTESTATIONS\Attestation " & module & " - " & nom & ".doc" _
        , FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", _
        AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
        EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
        :=False, SaveAsAOCELetter:=False
 

Discussions similaires

Statistiques des forums

Discussions
311 733
Messages
2 082 019
Membres
101 872
dernier inscrit
Colin T