SendKeysToWindow Works One Time But Won't Repeat

Question

I have an Excel workbook with a lot of business contacts. I need to send emails to some, but not all of them. Outlook is in an Enterprise environment and with only User permissions, I cannot make changes to the Macro or Object Model options in Outlook's Trust Center settings.

Initially I did try to use .Send (failed in Group Policy environment) and then set up a folder to programmatically send with an event driven .AddItem (failed in Group Policy environment). Both were tested - initially on an enabled Outlook installation to confirm the code atually worked. It did Then afterwords on a locked down Outlook installation and this failed.

I came here to research the prospect of using SendKeys to work around the inability use the above. I found a pretty useful thread here that included some code to use SendKeys specifically targeted to a specific window. It works. One time. The second email just sits there (doesn't send). And the code does not progress. If I click any open Excel window (any workbook or VBE) the emails sends and the next email opens and it just sits there. Until I again click any Excel window (any workbook or VBE), then the second email sends and the third just sits there. And so on and so and so on.

My only defense is that the code actually does work. I did test it. But only on a single email send. I only needed a proof of basic need to send in Outlook. And I can. But only one email at a time. Unless I sit there and keep clicking an Excel window to continue the code.

It does seem to me significant that clicking any Excel window continues the code (the code is running but waiting). But I can't seem to figure it out. "It" being, the code running continuously to the end without me clicking an Excel Window.

There is a controller workbook. The Controller contains the operational code and some parameters. The Controller opens a source data workbook (>107K records) and adds some columns. I build an ADODB recordset containing only the records I want. I use the recordset to build an email, and display it. This is where it pauses. It should send it and start over. There are no errors.

I should add something I just noticed. If I run the code directly from the VBE, it doesn't even send the first email. It builds it fine, but doesn't send it.

I include my slightly modified version in the code below.

Declare PtrSafe Function GetDesktopWindow Lib "USER32" () As LongPtr
Declare PtrSafe Function GetWindow Lib "USER32" (ByVal hwnd As LongPtr, ByVal wCmd As Long) As LongPtr
Declare PtrSafe Function GetWindowText Lib "USER32" Alias "GetWindowTextA" (ByVal hwnd As LongPtr, ByVal lpString As String, ByVal cch As LongPtr) As Long

Sub ProcessDataToEmail()

'MsgBox "ProcessDataToEmail"

    Counter_Sent = 0

    Set obj_ADODB_rsData = GetOLEDBRecordSetFromExcel(obj_XL_WS_Params.Range("OLEDB_Query").Value & obj_XL_WS_Params.Range("OLEDB_Query").Offset(1, 0).Value)
    
    Do While Not obj_ADODB_rs.EOF
        If Counter_Sent = 50 Then Exit Do
        
        If IsNull(obj_ADODB_rs.Fields(Col_Sent - 1).Value) Then
            BuildEmail
            MsgBox "Going to Send Keys"
            SendKeysToWindow obj_OL_MailItem.Subject
            MsgBox "Back from Send Keys"
'            ManageOutlookObjects False, "OL_MailItemNew", , , , , , , obj_OL_MailItem
            
            obj_XL_WS_Data.Cells(obj_ADODB_rs.Fields("ID").Value + 1, Col_Sent).Value = Now()
            Counter_Sent = Counter_Sent + 1
            obj_XL_WS_Params.Range("Sent_Counter").Value = Counter_Sent
        End If
        obj_ADODB_rs.MoveNext
    Loop

    obj_ADODB_rsData.Close
    Set obj_ADODB_rsData = Nothing

End Sub

Sub BuildEmail()

    MsgBox "Entering: BuildEmail"

    ManageOutlookObjects True, "OL_MailItemNew", , obj_OL_App, , , , , obj_OL_MailItem
    
    obj_OL_MailItem.To = obj_ADODB_rs.Fields(Col_Email - 1).Value
    obj_OL_MailItem.Subject = BuildEmailSubject
    obj_OL_MailItem.BodyFormat = olFormatHTML
    obj_OL_MailItem.HTMLBody = obj_XL_WS_Params.Range("Salutation").Value & " " & obj_XL_WS_Params.Range("Email_Body_1").Value & " " & obj_ADODB_rs.Fields(Col_LastName - 1).Value & "," & _
                    "<P>" & obj_XL_WS_Params.Range("Email_Body_2").Value & _
                    "<P>" & obj_XL_WS_Params.Range("Email_Body_3").Value & " " & obj_ADODB_rs.Fields(Col_City - 1).Value & _
                    " " & obj_XL_WS_Params.Range("Email_Body_4").Value & _
                    "<P>" & obj_XL_WS_Params.Range("Email_Body_5").Value & _
                    obj_XL_WS_Params.Range("Email_Signature_1").Value
    obj_OL_MailItem.Display

End Sub

Sub SendKeysToWindow(CaptionWindowsString As String)
Dim DesktopWindowHandle As LongPtr
Dim WindowHandle As LongPtr
Dim str_Buffer As String * 255
Dim str_Text As String

    DesktopWindowHandle = GetDesktopWindow
    WindowHandle = GetWindow(DesktopWindowHandle, 5)

    Do While (WindowHandle <> 0)

        str_Buffer = String$(255, Chr$(0))
        GetWindowText WindowHandle, str_Buffer, 255
        str_Text = String$(100, Chr$(0))
        WindowHandle = GetWindow(WindowHandle, 2)

        If InStr(str_Buffer, CaptionWindowsString) <> 0 Then
            AppActivate str_Buffer, True
            DoEvents
            SendKeys "%S", True
            DoEvents
            Exit Do
        End If

    Loop

End Sub

I've tried to add a recursive "SendKeysToWindow" targeted at the Controller window (without the sendkey step), I've added several MsgBoxes to see how far the code is getting. The last dialog it throws is MsgBox "Entering: BuildEmail". It does NOT THROW the MsgBox "Back from Send Keys"

Since the email does become visible (obj_OL_MailItem.Display) and it isn't hung or crashed, it must be pausing during or just after this line.

Answer 1

So I didn't actually "fix" the issue.

But I did manage to work around it as follows.

I removed the code that initiated the SendKeys ('SendKeysToWindow') after each email was created. This left all the emails completed and open (unsent) on the desktop.

Then, after all emails are completed, I reinserted a modified version of the 'SendKeysToWindow.'

The modification was to remove the Exit Do line that caused the process to end after a single email received the keys to be sent. Instead I used the existing SentCounter to count down to zero. in this way, the sub processes through all the open windows looking for the matching subject line and sends each one it find until the counter = 0. Then the code flow exits this sub.

This works well but isn't the desired solution as it gets pretty resource hungry to open and leave open 25-30 emails on the desktop before sending them all at once.

Anyway, it's working and I can press on but it anyone has any ideas as to what's actually happening with he above original code, I'd love to hear it.