Sendkeys en VBA

[nanard]

Bonjour,

J’ai un soucis avec mon code, il fonctionne très bien mais je dois utiliser Sendkeys «*^{enter}*» à la place de Send.
Le but du code est d’envoyer un mail en récupérant destinataires, sujet, corps du message dans un fichier Excel.
Mais l’instruction Sendkeys ne fonctionne pas, je n’ai pas d’erreur et je ne trouve pas la solution.
Pouvez vous m’aider ?
Merci

Sub EnvoyerEmail()
'-------------------------------------
'Permet d'envoyer un mail via outlook
'-------------------------------------

'Déclaration des variables
Dim OutApp As Object
Dim OutMail As Object
'***************************
Dim WBmail As Workbook
'***************************
Dim WSmail As Worksheet
'***************************
Dim Classeur As String
Dim CheminPieceJointe As String
'***************************
Dim PlagePieceJointe As Range
Dim Cellule As Range

'Initialisation des variables
Classeur = ThisWorkbook.Name
Set WBmail = Workbooks(Classeur)
Set WSmail = WBmail.Worksheets("Feuil1")
Set PlagePieceJointe = Range("B7:B11") 'plage des pièces jointes

'Créer une nouvelle instance d'Outlook
Set OutApp = CreateObject("Outlook.Application")

'préparer Outlook
PreparerOutlook OutApp

'Créer un nouvel e-mail
Set OutMail = OutApp.CreateItem(0)


'Configure les propriétés de l'e-mail
With OutMail
    .To = WSmail.Range("B2").Value ' Adresse e-mail du destinataire, pour mettre plusieurs destinataire "adresse1;" & "adresse2;" & "adresse3;" &...
    .CC = WSmail.Range("B3").Value ' Adresses e-mail en copie (optionnel)
    .BCC = WSmail.Range("B4").Value ' Adresses e-mail en copie cachée (optionnel)
    .Subject = WSmail.Range("B5").Value ' Sujet de l'e-mail
    .Body = WSmail.Range("B6").Value ' Corps de l'e-mail
    For Each Cellule In PlagePieceJointe
        If Cellule.Value <> "" Then
            CheminPieceJointe = Cellule.Value
            'Vérifie si le fichier existe et l'ajoute en pièce jointe
            If Dir(CheminPieceJointe) <> "" Then
                .Attachments.Add CheminPieceJointe '"C:\Chemin\Vers\Fichier.pdf" 'Ajoute une pièce jointe (optionnel)
            End If
        End If
    Next Cellule
'    .DeleteAfterSubmit = True 'suppression du mail après envoi true -> supprime / false -> ne suprrime pas / en commentaire ne supprime pas (optionnel)
    .Display   'affiche l'email (si vous ne voulez pas l'afficher, mettez cette ligne en commentaire) (optionnel)
'    .Save      'sauvegarde l'email avant l'envoi (pour ne pas le sauvegarder, mettez cette ligne en commentaire) (optionnel)
'    .SendUsingAccount = 'definir adresse expéditeur si plusieurs adresse dans OUTLOOK (optionnel)
'    .Send 'Envoie l'e-mail

End With

Application.Wait Now + TimeValue("00:00:05")
AppActivate OutMail
Application.Wait Now + TimeValue("00:00:05")
SendKeys "^{ENTER}", True

'Libère les objets
Set OutMail = Nothing
Set OutApp = Nothing

'Pour supprimer la tâche planifiée
Dim NomTache As String
Dim Commande As String
'Nom de la tâche à supprimer
NomTache = "ouvrir excel"
'Création de la commande
Commande = "schtasks /delete /tn """ & NomTache & """ /f"
'executer la tâche
Shell Commande

'pour effecer les adresses des destinataires et enregistrer le fichier
Range("B2:B4").Clear
Application.DisplayAlerts = False
WBmail.Save
Application.DisplayAlerts = True


End Sub

Private Sub PreparerOutlook(ByRef OutApp As Object)
'------------------------------------------------------------------------------------------------
'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 Resume Next
    'vérification si Outlook est ouvert
    Set OutApp = GetObject(, "Outlook.Application")
    
    If (Err.Number > 0) Then 'si Outlook n'est pas ouvert, une instance est ouverte
        Err.Clear
        Set OutApp = CreateObject("Outlook.Application")
        
        If (Err.Number > 0) Then
            MsgBox "Une erreur est survenue lors de l'ouverture de Outlook..." 'mettre en commentaire si vous ne voulez pas qu'il s'affiche
            Exit Sub
        Else
        End If
        
    Else    'si Outlook est ouvert, l'instance existante est utilisée
    End If
 
End Sub

-----

[umfred]

tu es sûr que le raccourci est fonctionnel?
que c'est bien Outlook qui a le focus à ce moment là?
que c'est la bonne version d'outlook qui accepte le CTRL+ENTREE pour envoyer le mail ?

le .Send commenté n'est pas censé faire l'envoi ?

[nanard]

Oui j’ai essayé manuellement et le CTRL + entrée fonctionne.
Si, le .send envoi le mail mais il y a une sécurité qui n’autorise pas l’utilisation du .send par un autre logiciel (Excel) que je ne peux pas désactiver.
Non je ne suis pas sûr que Outlook est le focus.

[umfred]

Si, le .send envoi le mail mais il y a une sécurité qui n’autorise pas l’utilisation du .send par un autre logiciel (Excel) que je ne peux pas désactiver.

bizarre, j'ai un classeur excel qui envoie un mail via outlook avec le .send sans souci chez moi.
Comment se manifeste ton problème de sécurité empêchant l'utilisation du .send ?

[A voir en vidéo sur Futura]

[nanard]

Dans la gestion de confidentialité de Outlook il y a la possibilité d’interdire l’utilisation d’outlook par d’autre logiciel.
La fonction Sendkeys fonctionne mais aléatoirement, par moment il envoie le mail et si je réessaie de suite sans rien changer il ne l’envoie pas.

[umfred]

si le mail est envoyé, il n'est plus visible, donc il ne peut être réenvoyer.
Pour l'option dans outlook, il faut l'ouvrir en tant administrateur pour pouvoir modifier ce paramètre (il faut que ton compte soit aussi administrateur pour bien faire)