Declare Function CloseClipboard Lib "User32" () As Long
Declare Function OpenClipboard Lib "User32" (ByVal hwnd As Long) As Long
Declare Function EmptyClipboard Lib "User32" () As Long
Dim X As Long
Sub autoopen()
'
' AutoOpen Macro
' Macro créée le 01/04/2005 par wetstein-chr
'
Dim Nom
Dim NomFichier
Dim MergeNom
MergeNom = "0000000000"
Nom = ActiveDocument.Name
NomFichier = "CPV AvenantElec Generique.txt"
'récupération du fichier de donnees dans le repertoire temporaire
Const TemporaryFolder = 2
Set fso = CreateObject("Scripting.FileSystemObject" )
Set tfolder = fso.GetSpecialFolder(TemporaryFolder)
On Error Resume Next
Set fichier = tfolder.Files("CPV AvenantElec Generique.txt" )
If IsObject(fichier) Then
On Error GoTo error1
' Effectuer la fusion dans le nouveau document crée => creation de doc3
With ActiveDocument.MailMerge
.MainDocumentType = wdFormLetters
.Destination = wdSendToNewDocument
.OpenDataSource ReadOnly:=True, Name:= _
fichier, ConfirmConversions:=False, _
LinkToSource:=False, AddToRecentFiles:=False, _
PasswordDocument:="", PasswordTemplate:="", WritePasswordDocument:="", _
WritePasswordTemplate:="", Revert:=False, Format:=wdOpenFormatAuto, _
Connection:="", SQLStatement:="", SQLStatement1:=""
MergeNom = ActiveDocument.MailMerge.DataSource.DataFields.Item("RefAvenant" )
'ActiveDocument.MailMerge.MainDocumentType = wdNotAMergeDocument
On Error GoTo error2
.Execute
On Error GoTo error1
End With
'Rétablir en document Word normal
'ActiveDocument.MailMerge.MainDocumentType = wdNotAMergeDocument
ChangeFileOpenDirectory tfolder
ActiveDocument.SaveAs FileName:=MergeNom, FileFormat:=wdFormatDocument, _
LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _
:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
False
' Fermeture du modele principal Doc1
Application.Documents(Nom).MailMerge.MainDocumentType = wdNotAMergeDocument
Application.Documents(Nom).Close SaveChanges:=False
Else
'Fichier introuveable
MsgBox "Le fichier " & NomFichier & " n'existe pas."
Application.Documents(Nom).MailMerge.MainDocumentType = wdNotAMergeDocument
Application.Documents(Nom).Close SaveChanges:=False
Exit Sub
End If
' FIN
Exit Sub
error1:
'MsgBox "Erreur lors du publipostage. Fermer toutes les fenêtres ", vbCritical
' FIN
Exit Sub
error2:
ActiveWindow.Close (no)
Selection.MoveLeft Unit:=wdCharacter, Count:=1
MsgBox "Publipostage inutile pour ce document", vbCritical
' Ouvre le presse-papiers
If OpenClipboard(0& ) = 0 Then
MsgBox "Impossible d'ouvrir le presse papier."
GoTo error1
End If
' Efface le contenu du presse-papiers
X = EmptyClipboard()
' Ferme le presse papier.
If CloseClipboard() = 0 Then
MsgBox "impossible de fermer le presse-papiers."
End If
' FIN
Exit Sub
End Sub