How do I grab any selected text from another app. without using of a clipboard ?

I need to know how can I detect and capture any selected text
from any running app. without using of a clipboard.

I have never used or tested the form-side part:

Well, that's my excuse :rolleyes:

Code:

---

'Module:
Private Declare Function GetWindowTextLength Lib "user32.dll" Alias "GetWindowTextLengthA" (ByVal hWnd As Long) As Long
Private Declare Function GetWindowText Lib "user32.dll" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal nMaxCount As Long) As Long
Private Declare Function EnumWindows Lib "user32.dll" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As Any, ByVal lpWindowName As Any) As Long
Private Declare Function IsWindowVisible Lib "user32" (ByVal hWnd As Long) As Long

Private Arry As String
Public Windows() As String
Public WindowHandles() As Long

Public Function EnumWindowsProc(ByVal hWnd As Long, ByVal lParam As Long) As Long
  Dim slength As Long, buffer As String  ' title bar text length and buffer
  Dim retval As Long  ' return value
  Static winnum As Integer

  winnum = winnum + 1  ' one more window enumerated....
  slength = GetWindowTextLength(hWnd) + 1  ' get length of title bar text
  If slength > 1 And IsWindowVisible(hWnd) > 0 Then
    buffer = Space(slength)  ' make room in the buffer
    retval = GetWindowText(hWnd, buffer, slength)  ' get title bar text
    If InStr(1, Arry, Left$(buffer, slength - 1), vbTextCompare) = 0 Then
        Arry = Arry & Chr$(216) & Left$(buffer, slength - 1)
    End If
  End If

  EnumWindowsProc = 1  ' return value of 1 means continue enumeration
End Function

Public Sub EWindows()
EnumWindows AddressOf EnumWindowsProc, CLng(0)
Windows = Split(Arry, Chr$(216), , vbTextCompare)
ReDim Preserve WindowHandles(Windows) As Long
For i = 0 To UBound(Windows)
    WindowHandles(i) = FindWindow(CLng(0), Trim$(Windows(i)))
Next:
End Sub

Function SeekWindowHwnd(SearchString As String) As Long
EWindows
For i = 0 To UBound(Windows)
    If InStr(1, Windows(i), SearchString, vbTextCompare) > 0 Then
        SeekWindowHwnd = WindowHandles(i)
        Exit Function
    End If
Next:
End Function

Function SeekWindowText(hWnd As Long) As String
EWindows
For i = 0 To UBound(Windows)
    If WindowHandles(i) = hWnd Then
        SeekWindowText = Windows(i)
        Exit Function
    End If
Next:
End Function


'Form:
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 SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private Const WM_COPY = &H301
Private Const WM_PASTE = &H302

Private Sub Form_Load()
EWindows
End Sub

Private Sub YourCmd_Click()
Dim TxthWnd As Long, AnhWnd As Long
Dim i As Integer

For i = 0 To UBound(WindowHandles)
    TxthWnd = FindWindowEx(WindowHandles(i), vbNull, "Edit" & vbNull, vbNullString)
    If Not (TxthWnd) Then
        TxthWnd = FindWindowEx(WindowHandles(i), vbNull, "RichEdit" & vbNull, vbNullString)
        If Not (TxthWnd) Then
            TxthWnd = FindWindowEx(WindowHandles(i), vbNull, "RICHEDIT_CLASS" & vbNull, vbNullString)
        End If
    End If
    If TxthWnd Then Exit For
Next:

If TxthWnd = 0 Then
    Debug.Print "Screw: Nothing found"
    Exit Sub
End If

Call SendMessage(TxthWnd, WM_COPY, 0&, 0&)

Call SendMessage(YourTextBox.hwnd, WM_PASTE, 0&, 0&)
End Sub

---

It should work in theory, but in practice, it doesn't.

Sorry :(

Maybe it works when you try?

Why not use the Clipboard? Next example will get the selected text from Notepad.

Code:

---

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) 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 FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Const WM_COPY = &H301
Const WM_PASTE = &H302

Private Sub Command1_Click()
    Dim hParent As Long
    Dim hChild As Long
    Dim strTemp As String
   
    hParent = FindWindow("Notepad", vbNullString)
    hChild = FindWindowEx(hParent, 0&, "Edit", vbNullString)
    SendMessage hChild, WM_COPY, 0, 0
    SendMessage Text1.hwnd, WM_PASTE, 0, 0
End Sub

---

Your Code works fine but, It dose not Seem to work on web pages. I have been looking for this code for a long time and if you could make it work on all pages I will get my answer.

Thanks