none
publipostage Access et word puis envoie avec outlook RRS feed

  • Discussion générale

  • Bonjour


    J'ai des documents Word qui sont stockés dans un répertoire "Email.
    Sous access j'ai une base de données qui s'appelle "tblDatenquelle".
    Le puplipostage avec word et outlook fonctionne.
    Je voudrais sous access, faire le publipostage avec ma base de données et inserer ce publipostage dans le ".body" de outlook puis l'envoyer par outlook a une adresse email
    Ci dessous le programme que j'ai fait qui ne fonctionne pas.

    Merci d'avance pour votre aide..

    Francis

    --------------------------------------------------------------------------

    Option Explicit

    Public Sub OpenSB(lngID As Long, docFile As String, _
                        destination As WdMailMergeDestination, Optional strSubject As String = "")

        Dim wrdApp      As New Word.Application
        Dim wrdDoc      As Word.Document

        Dim objMM       As Word.MailMerge
        Dim objDS       As Word.MailMergeDataSource

        Dim sQuery      As String

        Dim blnFound    As Boolean

          Set wrdDoc = wrdApp.Documents.Add(docFile)
          Set objMM = wrdDoc.MailMerge

          sQuery = "SELECT * FROM [tblDatenquelle] WHERE id = " & lngID

          objMM.OpenDataSource Name:=CurrentProject.FullName, LinkToSource:=True, _
                                SQLStatement:=sQuery


           Set objDS = objMM.DataSource
           objMM.ViewMailMergeFieldCodes = False

           objMM.destination = destination

            objMM.EditMainDocument
            objMM.MailSubject = strSubject
            objMM.MailFormat = wdMailFormatHTML
            objMM.MailAddressFieldName = "email"
            objMM.MailAsAttachment = True
            objMM.Execute

    Finally:
        Set objDS = Nothing
        Set objMM = Nothing
        If Not destination = wdSendToNewDocument Then
            If Not wrdDoc Is Nothing Then wrdDoc.Close False
            If Not wrdApp Is Nothing Then wrdApp.Quit 'sehr langsam
        End If
        Set wrdDoc = Nothing
        Set wrdApp = Nothing

        Exit Sub

    Catch:
        MsgBox "une erreur c'est produite", vbCritical, "Fehler"
        Resume Finally

    End Sub

                                                                                               
    • Modifié Clarion68 vendredi 30 mars 2018 21:26
    vendredi 30 mars 2018 21:24