AppActivate losing focus

[Meg T]

Hi,

I'm trying to open a non-MS application and then use the SendKeys command. The window activates, but then it seems to lose focus by the next line (SendKeys). I can't even get it to work in Notepad with an example of simple code I found online:


Sub Write_Notepad()

AppActivate ("Untitled - Notepad")
SendKeys ("I am sending this from Excel VBA to NotePad")

End Sub


I can open a new Notepad window, but again, SendKeys won't write to it. With some variations of the code, I've had SendKeys text show up in the VBA text editor -- but never Notepad.

I am sure Notepad is activating in part because when I change the name, it throws an exception. This doesn't happen with "Untitled - Notepad."

Any suggestions appreciated!

Meg

 

[Kenneth Hobson]

Welcome to the forum!

Note that for Windows versions Vista+, UAC must be disabled for SendKeys() to work. Always try to find some other way to accomplish your goal.

Sub SavePartcorrect()
  Dim myPath As String, txtPath As String
  Dim rc As Long
  Dim wb As Workbook
  
  Set wb = ActiveWorkbook
  myPath = ThisWorkbook.Path & "\"
  txtPath = myPath & "Test.txt"
    
  rc = Shell("NOTEPAD.EXE " & txtPath, vbNormalFocus)
  AppActivate rc
  Application.Wait Now + TimeValue("00:00:01")
  SendKeys Application.UserName, True
  SendKeys "{Enter}", True
End Sub

 

[Meg T]

Thanks for the quick reply, Kenneth.

I've got Windows XP, so it doesn't seem as if the UAC setting is the issue.

The code you sent opened up the Notepad window and activated it -- I saw it flash on both these lines:

rc = Shell("NOTEPAD.EXE " & txtPath, vbNormalFocus)
AppActivate rc

but I still couldn't get any results from the SendKeys commands. It seems like this should work...

Meg

 

[Kenneth Hobson]

Run it again. Add some more wait time if needed.

 

[wigi]

Hi Meg

My code is below, it works perfectly regarding my tests with an unsaved Notepad file:

Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long

Sub Wigi()

    AppActivate fWindowText("Untitled - Notepad", "")
    
    Application.Wait Now + TimeValue("00:00:01") / 100
    
    With New MSForms.DataObject
        .SetText "I am sending this from Excel VBA to NotePad"
        .PutInClipboard
    End With
    
    SendKeys "^V", True
    
End Sub

Function fWindowText(sWindowText As String, Optional sClass As String) As String

    Dim hWnd As Long, lRet As Long, sText As String
    hWnd = FindWindowEx(0, 0, vbNullString, vbNullString)
    Do While hWnd <> 0
        'ClassName
        sText = String(100, Chr(0))
        lRet = GetClassName(hWnd, sText, 100)
        If Len(sClass) = 0 Or Left(sText, lRet) = sClass Then
            'WindowText
            sText = String(100, Chr(0))
            lRet = GetWindowText(hWnd, sText, 100)
            If InStr(sText, sWindowText) Then
                fWindowText = Left(sText, lRet)
                Exit Function
            End If
        End If
        hWnd = FindWindowEx(0, hWnd, vbNullString, vbNullString)
    Loop
End Function

Don't forget to set a reference to Microsoft Form 2.0 Object Library.

The second part is a custom function I wrote, using 3 API calls.

 

[Kenneth Hobson]

Sendkeys() usually fails due to focus or timing. API's methods such as Wigi's fine solution may look complicated but are not all that bad considering the benefit.

The hard part to know sometimes when using API methods is to know what the window caption or title is and its classname. Here is a free spy program to help. It even shows you how to create API calls though some parts may be left out like constants. http://www.patorjk.com/

I would suggest though that you find another solution if possible. Even some of the old DOS programs accept command line parameters.

 

[Meg T]

Thanks for the replies, guys!

Wigi, I did enable the MS forms 2.0 object library. But I must be doing something wrong. When I ran your code, I got an “Invalid Procedure Call” error on the line

AppActivate fWindowText("Untitled - Notepad", "")

When I ran it step-by-step in the debugger, the fWindowText function did seem to execute, and went into a loop. It wasn’t immediately obvious to me what was wrong.

Kenneth, on your code, my computer beeps when it hits the SendKeys lines. I think it is trying to send those keystrokes somewhere, but the destination isn’t Notepad for some reason. When I change “SendKeys” to “Application.SendKeys,” the keystrokes get pasted into the VB editor. So SendKeys itself seems to work.

If it’s not obvious, I’m fairly new at this. I don’t know API. I suspect given my skill level and the fact I am actually trying to send keystrokes to a finicky database program, not just Notepad, I should give up. But the payoff would be big, so again, any help is appreciated.

Meg

 

[Kenneth Hobson]

Wigi's example assumes that you have a blank Notepad file open. You can force Notepad to open by use of this code just after Sub Wigi().

Shell "NotePad", vbNormalFocus

VBA is so fast, that it sends keys before your processes like opening a file or trying to open a non-existent file completes. For my code, this will help. Notice how I add text in the background without Notepad even open. Background methods work very fast. I just included it to show how to pre-create the file.

Sub SavePartcorrect()
  Dim myPath As String, txtPath As String
  Dim rc As Long
  Dim wb As Workbook
  
  Set wb = ActiveWorkbook
  myPath = ThisWorkbook.Path & "\"
  txtPath = myPath & "Test.txt"
  
  On Error Resume Next
  Kill txtPath
  MakeTXTFile txtPath, "First Line" & vbLf
    
  rc = Shell("NOTEPAD.EXE " & txtPath, vbNormalFocus)
  AppActivate rc, True
  
  Application.Wait Now + TimeValue("00:00:01")
  SendKeys "^{End}", True
  SendKeys Application.UserName, True
  SendKeys "{Enter}", True
End Sub

Sub MakeTXTFile(filePath As String, str As String)
  Dim hFile As Integer
  If Dir(FolderPart(filePath), vbDirectory) = "" Then
    MsgBox filePath, vbCritical, "Missing Folder"
    Exit Sub
  End If
  
  hFile = FreeFile
  Open filePath For Output As #hFile
  If str <> "" Then Print #hFile, str
  Close hFile
End Sub

There are many experts that can show you how to use ADO. ADO lets you interact with many databases. To see if your database can be connected through ADO, see: http://www.connectionstrings.com/

In VBE, check your Tools > References..., to be sure that you have no missing references. This usually causes problems that a prefixing of an object not normally required is required.

Sendkeys can be quirky depending on how you run the Sub. In my tests, I played the subs from the VBE play button or F5.

I would not consider giving up but then I like to learn.

 

[wigi]

For Notepad, still, try also:

Option Compare Text

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal HWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal HWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function BringWindowToTop Lib "user32" (ByVal HWnd As Long) As Long
Private Declare Function SetFocus Lib "user32" (ByVal HWnd As Long) As Long

Sub CopyCodeToForum()
'you need a reference to Microsoft Forms 2.0 Object Library
    
    With New MSForms.DataObject
        .SetText "I am sending this from Excel VBA to NotePad"
        .PutInClipboard
    End With

    Dim XLHWnd As Long

    XLHWnd = lWindowHandle("Untitled - Notepad", "Notepad")

    If XLHWnd Then
        If BringWindowToTop(XLHWnd) Then
            SetFocus XLHWnd
            Application.Wait Now + TimeValue("00:00:01") / 100
            Application.SendKeys "+{INSERT}", True
        End If
    End If

End Sub

Function lWindowHandle(sWindowText As String, Optional sClass As String) As Long

    Dim HWnd As Long, lRet As Long, sText As String
    HWnd = FindWindowEx(0, 0, vbNullString, vbNullString)
    Do While HWnd <> 0

        'ClassName
        sText = String(100, Chr(0))
        lRet = GetClassName(HWnd, sText, 100)
        If Len(sClass) = 0 Or Left(sText, lRet) = sClass Then

            'WindowText
            sText = String(100, Chr(0))
            lRet = GetWindowText(HWnd, sText, 100)
            If InStr(sText, sWindowText) Then
                lWindowHandle = HWnd
                Exit Function
            End If
        End If
        HWnd = FindWindowEx(0, HWnd, vbNullString, vbNullString)
    Loop
End Function

 

[Jaafar Tribak]

A couple of notes.

1- I would use the PID returned by the Shell function to get the right hwnd of the right notepad instance.

2- I would avoid using SendKeys as Kenneth pointed out to prevent focus & timing issues. Instead I would send the WM_SETTEXT message which works reliably once we have the target window hwnd.

something like this : (Run the Test routine)

Option Explicit

Private Const GW_HWNDNEXT As Long = 2&
Private Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" _
(ByVal lpClassName As Long, _
ByVal lpWindowName As Long) As Long

Private Declare Function GetParent Lib "user32" _
(ByVal hwnd As Long) As Long

Private Declare Function GetWindowThreadProcessId Lib "user32" _
(ByVal hwnd As Long, _
lpdwProcessId As Long) As Long

Private Declare Function GetWindow Lib "user32" _
(ByVal hwnd As Long, _
ByVal wCmd As Long) As Long

Private Declare Function SendMessageByString Lib "user32" _
Alias "SendMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As String) As Long

Private Const WM_SETTEXT = &HC
Private Const GW_CHILD = 5

Private Function HwndFromPID(ByVal pid As Long) As Long

    Dim lHWND As Long, lPid As Long
    
    lHWND = FindWindow(ByVal 0&, ByVal 0&)
    Do While lHWND <> 0&
        If GetParent(lHWND) = 0& Then
            Call GetWindowThreadProcessId(lHWND, lPid)
            If lPid = pid Then
                HwndFromPID = lHWND
                Exit Do
            End If
        End If
        lHWND = GetWindow(lHWND, GW_HWNDNEXT)
    Loop

End Function


Sub Test()

    Dim lPid As Long, hwnd As Long
    
    Const TEXT As String = _
    "I am sending this from Excel VBA to NotePad." _
    & vbNewLine & "blah blah blah !"
    
    lPid = Shell("NOTEPAD.EXE ", vbMinimizedFocus)
    hwnd = HwndFromPID(lPid)
    hwnd = GetWindow(hwnd, GW_CHILD)
    If hwnd Then
        Call SendMessageByString(hwnd, WM_SETTEXT, ByVal 0&, ByVal TEXT)
    End If

End Sub