problème d'enregistrement ds fichier TMP j'ai besoin d'aide

problème d'enregistrement ds fichier TMP j'ai besoin d'aide - VB/VBA/VBS - Programmation

Marsh Posté le 17-05-2013 à 15:50:20    


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
 
 
 
 

Reply

Marsh Posté le 17-05-2013 à 15:50:20   

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed