Application.SendKeys stopped working

Hi all,

getting a bit of headache from this...

I have a simple macro that from Outlook Express sends emails, with the last code line to mimic ALT+S on the keyboard to send the message

Application.Wait (Now + TimeValue("0:00:02"))
Application.SendKeys "%s"

Yesterday I needed to install some new software that required at the end reinstalling of Microsoft Redistributable 2005. Not sure if for that reason but now the last line (the SendKeys) is not sending the email automatically anymore. What happens is:
-the email message windows pops up but is not being sent unless i do it manually (if i get rid of the two seconds pause ahead of that)
-have a VB error message that takes me before the SendKeys line (if I keep the two secs wait ahead of that)

It looks to me that either:
-the pc is not active anymore on the email message therefore the SendKeys doesnt work
-somehow the instruction finds the "door" shut by something else
-worse of all, the software has messed up with those send keys commands (tried to reinstall it but to no avail)

Any ideas, suggestions please?

Many thanks

Bondcrash

Hello Bondcrash,

This is a more reliable method.

Place this code in a Standard VBA Module

'Used to Find a window by Class or by Caption
 Public Declare Function FindWindow _
  Lib "User32.dll" _
    Alias "FindWindowA" _
      (ByVal lpClassName As String, _
       ByVal lpWindowName As String) As Long

Add this Code to your Macro

    DoEvents
    
   'Wait for Outlook Express window to show
    If Subj = "" Then Subj = "New Message"
      While Ret = 0
        Ret = FindWindow(vbNullString, Subj)
      Wend
    
   'Wait 2 seconds before sending keystrokes (for settling)
    Application.Wait (Now + TimeValue("0:00:02"))
    
   'Send the email  
    Application.SendKeys "%s"

Sincerely,
Leith Ross

Thanks a lot Leith. Getting close, I think. The code is as follows. This way is not running. Where would you put the DoEvents?

Best
BC


Sub Mail_Outlook_Express_Out()

Dim Recipient As String, Subj As String, HLink As String
Dim Recipientcc As String, Recipientbcc As String
Dim Msg As String
Recipient = "xxx@yyy.com"
Recipientcc = "yyy@xxx.com"
Recipientbcc = ""
Subj = Subj & Cells(15, 66).Text
Msg = WorksheetFunction.Substitute(Msg, vbNewLine, "%0D%0A")
HLink = "mailto:" & Recipient & "?" & "cc=" & Recipientcc _
& "&" & "bcc=" & Recipientbcc & "&"
HLink = HLink & "subject=" & Subj & "&"
HLink = HLink & "body=" & Msg
ActiveWorkbook.FollowHyperlink (HLink)

DoEvents

'Wait for Outlook Express window to show
If Subj = "" Then Subj = "New Message"
While Ret = 0
Ret = FindWindow(vbNullString, Subj)
Wend

'Wait 2 seconds before sending keystrokes (for settling)
Application.Wait (Now + TimeValue("0:00:02"))

'Send the email
Application.SendKeys "%s"


End Sub

I just checked.. the code Leth suggested works spot on calling the routine directly but not if it is being called by another routine. any suggestion???

Many thanks
BC

Ok - it works without any two seconds pause - I am just wondering how stable is going to be - it is very very quick - will it be missing emails?

Hello Bondcrash,

The DoEvents should be executed before the loop looking for the Outlook Express window. Not sure why it isn't working with the delay. Should be stable, but check periodically to see if any emails fail to be sent.

Sincerely,
Leith Ross