Bonjour,
Question difficile...
Suite à une demande d'un utilisateur du Forum, j'ai fait du code pour un fichier qui fonctionne sans problème SUR 2 POSTES différents en simultané sous Office 365 et OneDrive !!
Cet utilisateur m'a demandé d'ajouter un envoi de mail.
J'avais 2 possibilités pour lesquelles j'ai le code qui va bien:
- Mail CDO
- Mail Outlook
J'ai choisi Outlook et cela marche presque toujours SAUF que parfois le bidule Outlook ne répond plus (sans que je puisse savoir pourquoi) et Excel dit:
Regarde la pièce jointe 1112084
Ce truc n'arrive pas chez moi sous Office 2016 et je pense que c'est l'artillerie lourde Office 365 + OneDrive qui perd les pédales.
Que puis-je alors faire ?
1 - Tuer Excel
2 - Tuer Outlook
3 - Passer en CDO
4 - Autre ?
Comment savoir ce qui se passe dans Outlook pour que le Send ou le Display place Outlook dans les choux.
En fait je vous demande mais je pense que c'est incontrôlable dans cette architecture et que ça m... par essence !
Merci par avance pour tout conseil.
Bonjour,
Si cela peut aider
Public Adresse As String
Public Attachement As String
Public Objet As String
Public Corps As String
Sub EvoyerUn MailViaOutlook
'Charger les variables Adresse; Chemin complet de l'attachement (Optionel), Objet, Le corps du mail.
'Pour l'envoie Html on remplacera les retours à la ligne vbCrLf par <BR>
Corps = Replace(Corps, vbCrLf, "<BR>")
Corps = Bonjour & "<BR>" & Corps
Sendmail Objet, Adresse, Corps, True, Attachement
End sub
Module paramétré XLOneClick Envoie de mail Messagerie Outlook
Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub Sendmail(ByVal Objet As String, ByVal eMailAddress As String, ByVal Corps As String, Html As Boolean, Optional ByVal Attachement As String, Optional Afficher As Boolean, Optional Sauvegarder As Boolean, Optional Envoyer As Boolean)
If IsMissing(Afficher) = False Then Afficher = True
If IsMissing(Sauvegarder) = False Then Sauvegarder = True
If IsMissing(Envoyer) = False Then Envoyer = True
On Error GoTo EnvoyerEmailErreur
Dim Messagerie As Outlook.Application
Dim e_Mail As Outlook.MailItem
Dim Body As Variant
If Corps = "" Then
MsgBox "Le corps du mail est vide ", vbOKOnly, "Mailing X1c"
Exit Sub
End If
Body = Corps
'préparer Outlook
PreparerOutlook Messagerie
Set e_Mail = Messagerie.CreateItem(0)
'création de l'email
With e_Mail
.To = eMailAddress
.Subject = Objet
If Not Html = True Then
.BodyFormat = olFormatRichText
.Body = Body
Else
.BodyFormat = olFormatHTML
.HTMLBody = "<html><p>" & Body & "</p></html>"
End If
If Attachement <> "" Then .Attachments.Add Attachement
If Afficher = True Then .Display
If Sauvegarder = True Then .Save
If Envoyer = True Then .Send
DoEvents
Sleep 2000
End With
'Liberer la mémoire
If (Not (e_Mail Is Nothing)) Then Set e_Mail = Nothing
If (Not (Messagerie Is Nothing)) Then Set Messagerie = Nothing
Exit Sub
'Balise en cas d'erreur
EnvoyerEmailErreur:
'Liberer la mémoire
If (Not (e_Mail Is Nothing)) Then Set e_Mail = Nothing
If (Not (Messagerie Is Nothing)) Then Set Messagerie = Nothing
MsgBox "Le mail n'a pas pu être envoyé...", vbCritical, "Erreur"
End Sub
Private Sub PreparerOutlook(ByRef Messagerie As Object)
On Error GoTo PreparerOutlookErreur
On Error Resume Next
'vérification si Outlook est ouvert
Set Messagerie = GetObject(, "Outlook.Application")
If Err.Number <> 0 Then 'si Outlook n'est pas ouvert, une instance est ouverte
Err.Clear
Set Messagerie = CreateObject("Outlook.Application")
Else 'si Outlook est ouvert, l'instance existante est utilisée
Set Messagerie = GetObject("Outlook.Application")
Messagerie.Visible = True
End If
Exit Sub
PreparerOutlookErreur:
MsgBox "Une erreur est survenue lors de l'exécution de PreparerOutlook()..."
End Sub