Lancer outlook avec macro excel 2007

bruiz Messages postés 127 Statut Membre -  
eljojo_e Messages postés 1255 Statut Membre -
bonjour à tous,

en premier lieu , je suis débutant en macro excel.
A partir d'un fichier excel, j'ai une macro qui génére un fichier pdf. je souhaiterais lancer via une macro la messagerie outlook en automatique en récupérant l'adresse mail du client et en pièce jointe le fichier PDF généré.
j'ai beau parcourir les différents forums je ne trouve pas mon bonheur. Pourriez-vous SVP me venir en aide (avec des explications simples SVP!!!)
Merci pour vos réponses.
Cordialement

1 réponse

  1.
    eljojo_e Messages postés 1255 Statut Membre 155
     
    Bonjour,

    J'ai fait un code pour lancer une messagerie thunderbird avec une/plusieurs pièce jointe, tu peut t'en inspirer :

    Sub CmdPEmail()

    dossier = Sheets("Configuration").Range("e2").Value ' par défaut C:\Program Files\Mozilla Thunderbird
    dossier2 = Len(Dir(dossier, vbDirectory))
    If dossier2 <> 0 Then
    Else
    MsgBox ("La messagerie 'Mozilla Thunderbird' n'a pas été trouvé dans" & vbLf & vbLf & dossier)
    GoTo a:
    End If

    Dim dlgOpen As FileDialog
    Dim FichierSélectionné As Variant

    'joindre un/plusieurs fichier(s)

    Select Case MsgBox("Joindre des fichiers au mail ???", vbInformation + vbYesNo, "Joindre fichiers")
    Case vbYes
    azf = ""
    Set dlgOpen = Application.FileDialog(msoFileDialogOpen)
    With dlgOpen
    '.InitialFileName = tr 'pour répertoire racine par exemple
    .Show
    .Title = "Joindre un/des fichiers au mail"
    For Each FichierSélectionné In .SelectedItems
    If FichierSélectionné <> "" Then azf = azf & "," & FichierSélectionné
    Next
    End With
    If IsNull(azf) Or azf = "" Then
    Else
    azf = Right(azf, Len(azf) - 1)
    End If
    Case vbNo
    End Select

    Set OuvrirFichier = Nothing
    Set dlgOpen = Nothing

    Call remplacer

    Sujet = Sheets("Mailing").Range("b4").Value
    Msg = Sheets("Mailing").Range("b6").Value

    Dim a, b
    b = ""

    For a = 4 To 188
    If Sheets("Mailing").Range("m" & a).Value <> "" Then
    b = b & Sheets("Mailing").Range("m" & a).Value & ","
    Else
    If b = "" Then Exit Sub
    End If
    Next

    qui = "'" & b & "'"

    toto = dossier & "\thunderbird -compose attachment=" & "'" & azf & "'" & ",body=" & Msg & ",subject=" & Sujet & ",to=" & qui ''C:\temp\info.doc,C:\temp\food.doc'
    Call Shell(toto)

    a:
    ActiveWorkbook.Saved = True
    End Sub

    J'ai aussi intégrer le remplacement des virgules car thunderbird n'aime pas les virgules :

    Sub remplacer()

    Sheets("Mailing").Range("B6:J34").Select
    Cells.Replace What:=",", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
    End Sub

    (Le mieu si tu veu pas te prendre la tête c'est d'installer thunderbird et ce code fonctionne très bien)

    Je peut t'envoyer le fichier excel complet si tu veut,

    Cordialement,
    0