SendKeys permission refusée

Version imprimable

13/02/2017, 12h44
touche_a_tout

SendKeys permission refusée

Bonjour,
J'ai emprunté à John Walkenbach ("VBA pour Excel 2003", un peu vieilli) une procédure d'envoi de courriels en série qui utilise SendKeys (que l'auteur déconseille, mais je n'ai pas le choix) et que j'ai adaptée à mes besoins. Elle me pose 2 problèmes mais je ne parle ici que du premier: La dernière instruction est [SendKeys "%s", True], qui déclenche le message d'erreur 70: permission refusée.
Comme j'ai repris ici textuellement le code de Walkenbach, je ne comprends pas pourquoi. Est-ce que quelqu'un peut m'expliquer ?
D'avance merci beaucoup.
Cordialement
Pierre
P.S. Le reste du code est à disposition pour clarifier la demande.
13/02/2017, 12h51
joe.levrai

Bonjour,

nous montrer la procédure complète serait d'une grande aide

peux-tu également nous expliquer pourquoi tu es obligé de faire un SendKeys ? Je ne dis pas qu'on pourra forcément s'en passer (je l'utilise sur certains envoi de mail dans un cas très précis), mais SendKeys ne doit être que la solution de dernier ressort, on doit donc s'assurer que tu es dans ce cas là
13/02/2017, 13h49
unparia

Bonjour pierruel
J' "adore" (euh ...) que tu nous exposes que Sendkeys est le problème . Tu en fais même le titre de ta discussion !
Le message reçu est pourtant clair : il ne concerne pas SendKeys, mais l'instruction que SendKeys est censée exécuter. C'est CETTE instruction, qui est rejetée, pas SendKeys...
Et nous ignorons tout de cette instruction, puisque tu ne prends même pas la peine de nous exposer à quel moment et depuis où très exactement tu fais cette simulation de touches. Elle est bien bonne, celle-là, tiens ... !

Quant à ce Monsieur, dont tu nous cite le nom : ce n'est pas mon voisin, j'ignore totalement qui il est et cela ne me regarde pas. Seul son code (celui que tu as utilisé) me regarderait, puisque c'est lui (et pas ce Monsieur) qui provoque ton message d'erreur. Or, j'ai beau regarder ton message, je ne le vois pas, ce code ! Il faut peut-être que j'ouvre, pour te renseigner, Google et y fasse une recherche ... pour savoir ce dont il peut bien s'agir ?????:roll:
C'est une plaisanterie ?

Peux-tu nous indiquer le client de messagerie dont tu disposes ? Un Outlook par exemple ? Ou un autre logiciel ?

parce que bon, quand je crois avoir trouvé la procédure dont tu parles, je ne puis que comprendre que son auteur en ai déconseillé l'utilisation ...

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
 
Sub SendEMail()
    Dim Email As String, Subj As String
    Dim Msg As String, URL As String
    Dim r As Integer, x As Double
    For r = 2 To 4 'data in rows 2-4
'       Get the email address
        Email = Cells(r, 2)
 
'       Message subject
        Subj = "Your Annual Bonus"
 
'       Compose the message
        Msg = ""
        Msg = Msg & "Dear " & Cells(r, 1) & "," & vbCrLf & vbCrLf
        Msg = Msg & "I am pleased to inform you that your annual bonus is "
 
        Msg = Msg & Cells(r, 3).Text & "." & vbCrLf & vbCrLf
        Msg = Msg & "William Rose" & vbCrLf
        Msg = Msg & "President"
 
'       Replace spaces with %20 (hex)
        Subj = Application.WorksheetFunction.Substitute(Subj, " ", "%20")
        Msg = Application.WorksheetFunction.Substitute(Msg, " ", "%20")
 
'       Replace carriage returns with %0D%0A (hex)
        Msg = Application.WorksheetFunction.Substitute(Msg, vbCrLf, "%0D%0A")        
 
'       Create the URL
        URL = "mailto:" & Email & "?subject=" & Subj & "&body=" & Msg        
 
'       Execute the URL (start the email client)
        ShellExecute 0&, vbNullString, URL, vbNullString, vbNullString, vbNormalFocus
 
'       Wait two seconds before sending keystrokes
        Application.Wait (Now + TimeValue("0:00:02"))
        Application.SendKeys "%s"
    Next r
End Sub

Peut-être qu'en 2003 c'était "dans les règles", mais en 2017 va falloir quand même passer à des choses plus actuelles de l'évolution du des possibilités offertes par VBA ;)

On t'attend, soigne tes explications

SendKeys permission refusée

Bonjour le paria et M.Levrai,
Moi, j'adore les facéties du paria, dont j'ai fait l'expérience, mais les autres farceurs sont également appréciés.
Visiblement, vous avez une vaste expérience de ce forum et pourtant vous semblez ignorer ce qu'écrit un de ses responsables dont le nom m'échappe: "On ne joint pas du code à l'entame d'un sujet". Donc je n'en ai pas joint (mais on n'en est plus à l'entame, voir plus bas).
Le code que tu as trouvé, Joe, ressemble beaucoup à celui que j'ai adapté, mais il y a des détails qui diffèrent. Par exemple, dans son bouquin, Walkenbach omet "Application." avant SendKeys "%s". Cause du bug ?
Pourquoi SendKeys ? Parce que Mozilla Thunderbird n'est pas reconnu par l'autre procédure que l'auteur propose.
Vous n'ignorez pas tout de l'instruction qui coince, elle est citée dans ma demande:
(SendKeys) "%s".
J'utilise la simulation de touches exactement depuis cette instruction-là, qui est la dernière de la procédure (excepté End If, Next et End Sub).
Quant au code, le voici au complet:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 Sub SendEmail_2() Dim cell As Range Dim Subj As String Dim EmailAddr As String Dim Recipient As String Dim Bonus As String Dim Msg As String Dim HLink As String Dim WordApp As Object Dim mon_annexe As Object Set mon_annexe = GetObject("E:\2_M_E_S__P_R_O_J_E_T_S\LeCourant\e_mailing\Annexe_bidon1.doc") For Each cell In Columns("C").Cells.SpecialCells(xlCellTypeConstants) If cell.Value Like "*@*" Then 'Obtenir les données Subj = "Notre Bulletin interne" Recipient = cell.Offset(0, -1).Value & " " & cell.Offset(0, -2).Value EmailAddr = cell.Value 'Composer le message Msg = "Bonjour, cher" & " " & Recipient & "%0A" Msg = Msg & "%0A" & "Nous te faisons parvenir le dernier bulletin" Msg = Msg & "%0A" & "de notre association " Msg = Msg & "%0A" & "et te souhaitons une agréable lecture." Msg = Msg & "%0A" & "Amitiés" Msg = Msg & "%0A" & "L'équipe du Bulletin interne" 'Construire lien hypertexte HLink = "mailto:" & EmailAddr & "?" HLink = HLink & "subject=" & Subj & "&" HLink = HLink & "attachment=" & mon_annexe.Name & "&" HLink = HLink & "body=" & Msg 'Transmettre le message ActiveWorkbook.FollowHyperlink HLink Application.Wait (Now + TimeValue("0:00:03")) SendKeys "%s", True End If Next End Sub
Maintenant qu'on a bien rigolé, une réponse concrète serait appréciée.
Bien à vous
Pierre
(On apprend à tout âge; j'ai 82 berges)

13/02/2017, 17h03
joe.levrai

Ce n'est pas ton code qui est malvenu de montrer, c'est de balancer un fichier en pièce jointe, si tu fais référence au Post de Pierre Fauconnier suivant : https://www.developpez.net/forums/d8...s-discussions/

Notre grande expérience du forum nous permet surtout de savoir qu'il existe peu de sujets qui n'aient déjà été abordés au moins une fois, et que l'outil de recherche est assez efficace quand on lui passe la bonne commande
il y a pas mal de sujet sur le forum qui ont traité d'envois de mails avec ce logiciel
le premier que j'ai trouvé : https://www.developpez.net/forums/d7...l-thunderbird/

la méthode est radicalement différente, est-ce que c'est une piste qui pourrait répondre à ton besoin ? Sinon, fait juste une recherche sur le forum avec comme mot clé "vba firebird", ça devrait déjà te ramener du contenu à interroger ;)

SendKeys permission refusée

Bonsoir Joe levrai,
J'ai mal lu Pierre Fauconnier, désolé.
Merci, ta piste est très intéressante, entre autres parce que la solution est plus compacte.
J'ai tenté de l'adapter à mes besoins (boucle For...next dans une feuille contenant les divers destinataires) et à mon message. Problème:
l'instruction Call Shell(strcommand, vbNormalFocus) provoque l'erreur "fichier introuvable". De quel fichier est-il question ? Avec le curseur sur la variable "fichierjoint" (2 lignes au-dessus) le filename avec le path complet s'affiche dans la bulle. Voici le code:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 Option Explicit Private Sub CommandButton1_Click() Dim adr_destinataire, sujet, fichierjoint, body As String Dim cell As Range Dim strcommand As String 'destinataire = "titi@toto.com,tata@toto.com" sujet = "Bulletin interne" ThisWorkbook.Sheets("listing").Activate For Each cell In Columns("C").Cells.SpecialCells(xlCellTypeConstants) If cell.Value Like "*@*" Then adr_destinataire = cell.Value End If body = "Cher/chère" & " " & cell.Offset(0, -1).Value & " " & _ cell.Offset(0, -2).Value & Chr(10) body = body & " " & "Nous te faisons parvenir le dernier bulletin" body = body & " " & "de notre association " body = body & " " & "et te souhaitons une agréable lecture." & Chr(10) body = body & "Amitiés" & Chr(10) body = body & "L'équipe du bulletin interne" & Chr(10) fichierjoint = ("E:\2_M_E_S__P_R_O_J_E_T_S\LeCourant\e_mailing\Annexe_bidon1.doc") strcommand = "C:\Program Files\Mozilla Thunderbird\thunderbird.exe" strcommand = strcommand & " -compose " & "to='" & adr_destinataire & "'" strcommand = strcommand & "," & "subject=" & sujet & "," strcommand = strcommand & "body=" & body strcommand = strcommand & "," & "attachment=file:///" & fichierjoint MsgBox strcommand Call Shell(strcommand, vbNormalFocus) Next End Sub
Il est peut-être temps de modifier l'intitulé de la discussion. Possible ?
Merci pour tout éclaircissement.
Salut
Pierre

13/02/2017, 22h09
touche_a_tout

Sendkeys permission refusée

Re,
J'ai trouvé le bug du fichier: erreur de répertoire (x86).
Reste un problème: le message se compose, la pièce jointe est annexée mais le mél n'est pas envoyé. Je ne vois d'ailleurs pas d'instruction du genre "send" dans le code. Quelle est l'instruction exacte et où l'introduire ?
Merci pour toute aide.
Cordialement
Pierre