code vba "envoyer recevoir" outlook

andrekn13 · 23 Mars 2014

Je cherche à trouver une solution pour , qu'une fois mon mail soit envoyé à partir de mon code excel vba, Outlook se réactive pour faire l'envoi réellement. Car il se loge dans " à envoyer", et Outlook se ferme. je dois donc le réouvrir "manuellement" pour procéder à l' envoi.
j'ai essayé pleins de paramètres dans Outlook, comme "hors connexion" toutes les minutes, mais je pense que lorsqu'il est fermé, rien n'y fait.

Dim X As String
Dim Y As String
Dim Z As String
Dim nomUtilisateur As String
Dim CheminDuFichier As String

X = Range("E45").Value
Y = Range("E11").Value
Z = Range("H17").Value
CheminDuFichier = Z & " - " & Y & " - " & X & " € " & ".pdf"

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\Users\" & Environ("username") & "\Desktop\" & CheminDuFichier, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, From:=1, To:=1, OpenAfterPublish:=False

Set olApp = CreateObject("Outlook.application")
Set M = olApp.CreateItem(ol_MailItem)
With M
M.To = Range("E19").Value 'le destinataire
M.Subject = " facture"
M.Body = "Bonjour" & vbCr & "Veuillez trouver ci-joint mon offre de prix" & vbCr & " Cordialement " 'texte a rajouter"
M.Attachments.Add "C:\Users\" & Environ("username") & "\Desktop\" & CheminDuFichier
'Set oBjMail = Nothing
.Display
SendKeys "^{ENTER}"
M.send
nomUtilisateur = Application.UserName
Kill "C:\Users\" & nomUtilisateur & "\Desktop\" & CheminDuFichier

Set oBjMail = Nothing
Set olApp = Nothing
'Application.Dialogs(xlDialogSendMail).Show

Normalement, " .Send" doit il l' envoyer même si Outlook se ferme du moment qu'il commence cette tâche et qu'il continue en travail de fond et c'est mon Outlook qui bugg ? ou je doit rajouter une commande pour qu'il l'envoi avant de fermer ?
Si quelqu'un connaît la réponse .... je le remercie par avance.

Elie diemer · 5 Septembre 2021

andrekn13 à dit:
Je cherche à trouver une solution pour , qu'une fois mon mail soit envoyé à partir de mon code excel vba, Outlook se réactive pour faire l'envoi réellement. Car il se loge dans " à envoyer", et Outlook se ferme. je dois donc le réouvrir "manuellement" pour procéder à l' envoi.
j'ai essayé pleins de paramètres dans Outlook, comme "hors connexion" toutes les minutes, mais je pense que lorsqu'il est fermé, rien n'y fait.

Dim X As String
Dim Y As String
Dim Z As String
Dim nomUtilisateur As String
Dim CheminDuFichier As String

X = Range("E45").Value
Y = Range("E11").Value
Z = Range("H17").Value
CheminDuFichier = Z & " - " & Y & " - " & X & " € " & ".pdf"

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\Users\" & Environ("username") & "\Desktop\" & CheminDuFichier, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, From:=1, To:=1, OpenAfterPublish:=False

Set olApp = CreateObject("Outlook.application")
Set M = olApp.CreateItem(ol_MailItem)
With M
M.To = Range("E19").Value 'le destinataire
M.Subject = " facture"
M.Body = "Bonjour" & vbCr & "Veuillez trouver ci-joint mon offre de prix" & vbCr & " Cordialement " 'texte a rajouter"
M.Attachments.Add "C:\Users\" & Environ("username") & "\Desktop\" & CheminDuFichier
'Set oBjMail = Nothing
.Display
SendKeys "^{ENTER}"
M.send
nomUtilisateur = Application.UserName
Kill "C:\Users\" & nomUtilisateur & "\Desktop\" & CheminDuFichier

Set oBjMail = Nothing
Set olApp = Nothing
'Application.Dialogs(xlDialogSendMail).Show

Normalement, " .Send" doit il l' envoyer même si Outlook se ferme du moment qu'il commence cette tâche et qu'il continue en travail de fond et c'est mon Outlook qui bugg ? ou je doit rajouter une commande pour qu'il l'envoi avant de fermer ?
Si quelqu'un connaît la réponse .... je le remercie par avance.

essaie ceci

Send/Receive in Outlook via code

If I create an Outlook 2010 object In Excel VBA using Sub CreateOL() On Error Resume Next Set myOlApp = GetObject(, "Outlook.Application") If Err.Number = 429 Then Set myOl...

stackoverflow.com

Public Sub Send_Recieve_Out()
Dim oLook As Object
Dim nsp As Object, objSyncs As Object, objSync As Object
Dim i As Long

Set oLook = GetObject(, "Outlook.Application")

Set nsp = oLook.GetNamespace("MAPI")

Set objSyncs = nsp.SyncObjects

For i = 1 To objSyncs.Count
Set objSync = objSyncs.Item(i)
objSync.Start
Next
End Sub

Valtrase · 5 Septembre 2021

Salut à tous
Bon déjà j'ai pas lu tous les post, donc désolé si je passe à coté de quelque-chose ou si mon code est redondant.
Mais j'utilise ce code qui fonctionne très bien

VB:

'————————   REFERENCES   ————————————————————————————————————————————————————————————————————————————————————————————————————————————————————————————————————————————————
' Microsoft Outlook XX.0 Object Library


Sub EnvoyerEmail()
'par Excel-Malin.com ( https://excel-malin.com )

    On Error GoTo EnvoyerEmail_Erreur
    Dim oOutlook As Outlook.Application
    Dim WasOutlookOpen As Boolean
    Dim oMailItem As Outlook.MailItem
    Dim Body As Variant
    Dim Filename1 As String
    Dim Subject As String
    Dim sFolder As String

    sFolder = AddBackslash(GetParam("Path.Pdf", DossierSpecial(Bureau)))
    If Not (fsoFolderExist(sFolder)) Then
        DisplayErr sFolder, FileNoFound
        UserForm1.Show
    End If
    Filename1 = sFolder & _
                fsoFileExt(ThisWorkbook.Name, efFile) & " " & Range("Semaine") & ".pdf"
    Subject = fsoFileExt(ThisWorkbook.Name, efFile) & " " & Range("Semaine")

    '    If fsoFileExist(Filename1) Then
    ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, _
                                       Filename:=Filename1, _
                                       Quality:=xlQualityStandard, IncludeDocProperties:=False, _
                                       IgnorePrintAreas:=False, From:=1, To:=1, OpenAfterPublish:=False
    '    Else
    '        DisplayErr Filename1, FileNoFound
    '        GoTo EnvoyerEmail_Exit
    '    End If


    '    Body = "<!DOCTYPE HTML PUBLIC ""-//W3C//DTD HTML 4.0 Transitional//EN"">" & _
         '           "<HTML><HEAD>" & _
         '           "<META http-equiv=Content-Type content=""text/html; charset=iso-8859-1"">" & _
         '           "<META content=""MSHTML 6.00.2800.1516"" name=GENERATOR></HEAD>" & _
         '           "<BODY><DIV STYLE=""font-size: 12px; font-face: Book Antiqua;"">" & "Bonjour Corine," & "<br>" & _
         '           "Ci-joint la feuille de pointage sur Carrefour Claira, pour la semaine " & Range("Semaine") & "<br><br>" & "Cordialement, " & _
         '           StrConv(Range("Prénom"), vbProperCase) & "</DIV></BODY></HTML>"

    Body = "<H3> <B> CENTRE COMMERCIAL CARREFOUR CLAIRA: Remplaçant M. " & _
           Range(" Nom") & Range("Prénom") & " </B> </H3>" & _
           "Bonjour Corine, <br>" & _
           "Ci-joint les documents pour la semaine 25" & "<br> <br>" & _
           "Cordialement, " & Range("Prénom")

    'Application_ItemSend
    'Préparer Outlook
    PreparerOutlook oOutlook
    Set oMailItem = oOutlook.CreateItem(0)

    Dim SendToCopy As String: SendToCopy = "Tata@laposte.net"
    Dim SendTo As String: SendTo = "Tutu@free.fr"
    Dim SendFrom As String: SendFrom = "Monadresse@monprovider.fr"
    Dim SigString As String
    Dim Signature As String

    '    'Récupération de la signature
    '    SigString = AddBackslash(Environ("appdata")) & "Microsoft\Signatures\toto.htm"
    ' // pour la signature ne fonctionne que si un seul compte est paramètré'
    '    If Dir(SigString) <> "" Then
    '        Signature = GetBoiler(SigString)
    '    Else
    '        Signature = ""
    '    End If

    'Création de l'email
    With oMailItem
        '.SentOnBehalfOfName =  "Travail"
        '.Sender = Range("Sender")
        '.From = SendFrom
        .To = SendTo
        If SendToCopy <> "" Then .CC = SendToCopy
        .Subject = Subject

        'CHOIX DU FORMAT
        '----------------------
        'email formaté comme texte
        '            .BodyFormat = olFormatRichText
        '            .Body = Body
        'ou
        'email formaté comme HTML
        '.BodyFormat = olFormatHTML
        .HTMLBody = Body & "<BR> <BR>" & .HTMLBody              'Signature
        .Attachments.Add Filename1
        ' // si on veux l'afficher
        '.Display   '<- affiche l'email (si vous ne voulez pas l'afficher, mettez cette ligne en commentaire)
        
        '.Save      '<- sauvegarde l'email avant l'envoi (pour ne pas le sauvegarder, mettez cette ligne en commentaire)

        '.Send      '<- envoie l'email (si vous voulez seulement préparer l'email et l'envoyer manuellement, mettez cette ligne en commentaire)
    End With

EnvoyerEmail_Exit:
    If (Not (oMailItem Is Nothing)) Then Set oMailItem = Nothing
    If (Not (oOutlook Is Nothing)) Then Set oOutlook = Nothing

    Exit Sub

EnvoyerEmail_Erreur:

    MsgBox "Le mail n'a pas pu être envoyé..." & vbNewLine & Err, vbCritical, "Erreur"
    Resume EnvoyerEmail_Exit
End Sub

Private Sub PreparerOutlook(ByRef oOutlook As Object)
'par Excel-Malin.com ( https://excel-malin.com )
'Ce code vérifie si Outlook est prêt à envoyer des emails... Et s'il ne l'est pas, il le prépare.

    On Error GoTo PreparerOutlookErreur


    On Error Resume Next
    'vérification si Outlook est ouvert
    Set oOutlook = GetObject(, "Outlook.Application")

    If (Err.Number <> 0) Then                                   'si Outlook n'est pas ouvert, une instance est ouverte
        Err.Clear
        Set oOutlook = CreateObject("Outlook.Application")
    Else                                                        'si Outlook est ouvert, l'instance existante est utilisée
        Set oOutlook = GetObject("Outlook.Application")
        oOutlook.visible = True
    End If
    Exit Sub

PreparerOutlookErreur:
    MsgBox "Oups..." & vbNewLine & "Nous n'avons pas pu charger Outlook !"
End Sub


Function GetBoiler(ByVal sFile As String) As String
'Dick Kusleika
    Dim fso As Object
    Dim ts As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
    GetBoiler = ts.ReadAll
    ts.Close
End Function

code vba "envoyer recevoir" outlook

andrekn13

XLDnaute Occasionnel

Elie diemer

XLDnaute Nouveau

Send/Receive in Outlook via code

Valtrase

XLDnaute Occasionnel

Discussions similaires