I'm using this code to get a list of open windows:
Delegate Function EnumWindowDelegate(ByVal hWnd As IntPtr, ByVal Lparam As IntPtr) As Boolean
Private Callback As EnumWindowDelegate = New EnumWindowDelegate(AddressOf EnumWindowProc)
Private Function EnumWindowProc(ByVal hWnd As IntPtr, ByVal Lparam As IntPtr) As Boolean
If IsWindowVisible(hWnd) Then
Dim TheLength As Integer = GetWindowTextLengthA(hWnd)
Dim TheReturn(TheLength * 2) As Byte
GetWindowText(hWnd, TheReturn, TheLength + 1)
Dim TheText As String = ""
For x = 0 To (TheLength - 1) * 2
If TheReturn(x) <> 0 Then
TheText &= Chr(TheReturn(x))
End If
Next
If TheText <> "" Then
ListBox1.Items.Add(TheText & " (" & CStr(hWnd) & ")")
End If
End If
Return True
End Function
Private Declare Function EnumWindows Lib "User32.dll" (ByVal WNDENUMPROC As EnumWindowDelegate, ByVal lparam As IntPtr) As Boolean
Private Declare Auto Function GetWindowText Lib "User32.dll" (ByVal Hwnd As IntPtr, ByVal Txt As Byte(), ByVal Lng As Integer) As Integer
Private Declare Function IsWindowVisible Lib "User32.dll" (ByVal hwnd As IntPtr) As Boolean
Private Declare Function GetWindowTextLengthA Lib "User32.dll" (ByVal hwnd As IntPtr) As Integer
Usage: EnumWindows(Callback, IntPtr.Zero)
It works BUT if a window with a greek title is opened ex. 'Μουσική' this code outputs 'œ¿Åùº® '. As you can see something is wrong. Is there a way to fix this?
P.S. Sorry for my bad English :)
Ok I think i found the solution: Use GetWindowTextA instead of GetWindowText.
#Trevor suggested this in the comments of the question and I tried it but it didn't work. Somehow I managed to make it work.
Thanks to everybody who tried to help :). Here is the working code:
Delegate Function EnumWindowDelegate(ByVal hWnd As IntPtr, ByVal Lparam As IntPtr) As Boolean
Private Callback As EnumWindowDelegate = New EnumWindowDelegate(AddressOf EnumWindowProc)
Private Function EnumWindowProc(ByVal hWnd As IntPtr, ByVal Lparam As IntPtr) As Boolean
If IsWindowVisible(hWnd) Then
Dim TheLength As Integer = GetWindowTextLengthA(hWnd)
Dim TheReturn(TheLength * 2) As Byte
GetWindowText(hWnd, TheReturn, TheLength + 1)
Dim TheText As String = ""
For x = 0 To (TheLength - 1) * 2
If TheReturn(x) <> 0 Then
TheText &= Chr(TheReturn(x))
End If
Next
If Not TheText = "" Then
ListBox1.Items.Add(TheText & " (" & CStr(hWnd) & ")")
End If
End If
Return True
End Function
Private Declare Function EnumWindows Lib "User32.dll" (ByVal WNDENUMPROC As EnumWindowDelegate, ByVal lparam As IntPtr) As Boolean
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal Hwnd As IntPtr, ByVal Txt As Byte(), ByVal Lng As Integer) As Integer
Private Declare Function IsWindowVisible Lib "User32.dll" (ByVal hwnd As IntPtr) As Boolean
Private Declare Function GetWindowTextLengthA Lib "User32.dll" (ByVal hwnd As IntPtr) As Integer
Related
I found a code which would help one of my projects. However I can't use it in my 64bit MS Access.
This was the original post How to get Application name from process name?
Declare Function GetWindowThreadProcessId Lib "user32.dll" (ByVal hwnd As Int32, ByRef lpdwProcessId
As Int32) As Int32
Private Declare Function GetForegroundWindow Lib "user32" Alias "GetForegroundWindow" () As IntPtr
'Private Declare Auto Function GetWindowText Lib "user32" (ByVal hWnd As System.IntPtr, ByVal
lpString As System.Text.StringBuilder, ByVal cch As Integer) As Integer
Private makel As String
Private Function GetActiveAppProcess() As Process
Dim activeProcessID As IntPtr
GetWindowThreadProcessId(GetForegroundWindow(), activeProcessID)
Return Process.GetProcessById(activeProcessID)
End Function
Sub GetProcInfo()
Dim activeProcess As Process = GetActiveAppProcess()
With activeProcess
ApplicationName = .MainModule.FileVersionInfo.FileDescription
ProcessName = .ProcessName
WindowTitle = .MainWindowTitle
End With
End Sub
I have found a previous thread that shows how to get all open windows and their names using C# : get the titles of all open windows
However, I need to do this in VBA: does anyone know if that's possible?
Thank you so much.
Best regards
Here's a scrape from this microsoft answer by Andreas Killer that uses EnumWindows() which did the trick for me:
Option Explicit
#If Win64 Then
Private Declare PtrSafe Function GetWindowTextLengthA Lib "user32" ( _
ByVal hWnd As LongPtr) As Long
Private Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" ( _
ByVal hWnd As LongPtr, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" ( _
ByVal hWnd As LongPtr, ByVal nIndex As Long) As Long
Private Declare PtrSafe Function EnumWindows Lib "user32" ( _
ByVal lpEnumFunc As LongPtr, ByVal lParam As LongPtr) As Long
#Else
Private Declare Function GetWindowTextLengthA Lib "user32" ( _
ByVal hWnd 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 GetWindowLong Lib "user32" Alias "GetWindowLongA" ( _
ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function EnumWindows Lib "user32" ( _
ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
#End If
Private Sub debug_ListWindows()
ListWindows
End Sub
Private Function ListWindows()
EnumWindows AddressOf EnumFindWindowLikeProc, 0
End Function
#If Win64 Then
Private Function EnumFindWindowLikeProc(ByVal hWnd As LongPtr, ByVal lParam As Long) As Long
#Else
Private Function EnumFindWindowLikeProc(ByVal hWnd As Long, ByVal lParam As Long) As Long
#End If
If IsWindowVisible(hWnd) Then
If Len(Trim(WindowTitle(hWnd))) > 0 Then
Debug.Print WindowTitle(hWnd)
End If
End If
EnumFindWindowLikeProc = 1
End Function
#If Win64 Then
Private Function IsWindowVisible(ByVal hWnd As LongPtr) As Boolean
#Else
Private Function IsWindowVisible(ByVal hWnd As Long) As Boolean
#End If
Const GWL_STYLE = -16 'Sets a new window style
Const WS_VISIBLE = &H10000000 'The window is initially visible
Dim lngStyle As Long
lngStyle = GetWindowLong(hWnd, GWL_STYLE)
IsWindowVisible = ((lngStyle And WS_VISIBLE) = WS_VISIBLE)
End Function
#If Win64 Then
Property Get WindowTitle(ByVal hWnd As LongPtr) As String
#Else
Property Get WindowTitle(ByVal hWnd As Long) As String
#End If
Dim Contents As String, i As Long
Contents = Space$(GetWindowTextLengthA(hWnd) + 1)
i = GetWindowText(hWnd, Contents, Len(Contents))
WindowTitle = Left$(Contents, i)
End Property
and here is a pretty truncated version that loops using GetWindow() which should work on sufficiently new office installations:
Option Explicit
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" ( _
ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function GetWindowTextLengthA Lib "user32" ( _
ByVal hWnd As LongPtr) As Long
Private Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" ( _
ByVal hWnd As LongPtr, ByVal lpString As String, _
ByVal cch As LongPtr) As Long
Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" ( _
ByVal hWnd As LongPtr, ByVal nIndex As Long) As Long
Private Declare PtrSafe Function GetWindow Lib "user32" ( _
ByVal hWnd As LongPtr, ByVal wCmd As Long) As LongPtr
Private Sub debug_ListWindows()
ListWindows
End Sub
Private Function ListWindows()
Const GWL_STYLE = -16 'Sets a new window style
Const WS_VISIBLE = &H10000000 'The window is initially visible
Const GW_HWNDNEXT = 2 'The retrieved handle identifies the window below the specified window in the Z order
Dim hWnd As LongPtr
hWnd = FindWindow(vbNullString, vbNullString)
While hWnd
Dim sTitle As String
sTitle = Space$(GetWindowTextLengthA(hWnd) + 1)
sTitle = Left$(sTitle, GetWindowText(hWnd, sTitle, Len(sTitle)))
If (GetWindowLong(hWnd, GWL_STYLE) And WS_VISIBLE) = WS_VISIBLE Then 'only list visible windows
If Len(Trim(sTitle)) > 0 Then 'ignore blank window titles
Debug.Print sTitle
End If
End If
hWnd = GetWindow(hWnd, GW_HWNDNEXT)
Wend
End Function
Sub ListWindows()
Dim wn As Excel.Window
For Each wn In Application.Windows
Debug.Print wn.Caption
Next wn
End Sub
if you wanted to activate any of them simply use:
wn.Activate
I want to know how to send a string to a List box of another Application. I already know how to do it but now I have encountered another problem. The string is sent to a different listbox or textbox. The code that I used is shown below. My question is is there a hWndChildAfter for GetWindow() like FindWindowEx(hWndParent, hWndChildAfter, lpszClass, lpszWindow)?
'Declarations/ETC
Const WM_SETTEXT As Long = &HC
Private Declare Auto Function FindWindow Lib "user32.dll" (ByVal lpClassName As String, ByVal lpWindowName As String) As IntPtr
Private Declare Auto Function FindWindowEx Lib "user32.dll" (ByVal hWndParent As IntPtr, ByVal hWndChildAfter As IntPtr, ByVal lpszClass As String, ByVal lpszWindow As String) As IntPtr
Declare Function GetWindow Lib "user32.dll" (ByVal hWnd As IntPtr, ByVal uCmd As Integer) As IntPtr
Declare Function SendMessageHM Lib "user32.dll" Alias "SendMessageA" (ByVal hWnd As IntPtr, ByVal wMsg As Int32, ByVal wParam As Int32, ByVal lParam As String) As Int32
Enum GetWindow_Cmd
GW_HWNDFIRST = 0
GW_HWNDLAST = 1
GW_HWNDNEXT = 2
GW_HWNDPREV = 3
GW_OWNER = 4
GW_CHILD = 5
GW_ENABLEDPOPUP = 6
End Enum
'Usage
Dim hWnd1 As IntPtr = FindWindow(FormClass, FormCaption)
Dim hWndR2 As IntPtr = GetWindow(hWnd1, GetWindow_Cmd.GW_CHILD)
SendMessageHM(hWndR2, WM_SETTEXT, 0, TextBox1.Text)
And I would like to do it like the code below but won't work.
'Declarations/ETC
Const WM_SETTEXT As Long = &HC
Private Declare Auto Function FindWindow Lib "user32.dll" (ByVal lpClassName As String, ByVal lpWindowName As String) As IntPtr
Private Declare Auto Function FindWindowEx Lib "user32.dll" (ByVal hWndParent As IntPtr, ByVal hWndChildAfter As IntPtr, ByVal lpszClass As String, ByVal lpszWindow As String) As IntPtr
Declare Function GetWindow Lib "user32.dll" (ByVal hWnd As IntPtr, ByVal uCmd As Integer) As IntPtr
Declare Function SendMessageHM Lib "user32.dll" Alias "SendMessageA" (ByVal hWnd As IntPtr, ByVal wMsg As Int32, ByVal wParam As Int32, ByVal lParam As String) As Int32
Enum GetWindow_Cmd
GW_HWNDFIRST = 0
GW_HWNDLAST = 1
GW_HWNDNEXT = 2
GW_HWNDPREV = 3
GW_OWNER = 4
GW_CHILD = 5
GW_ENABLEDPOPUP = 6
End Enum
'Usage
Dim MainWindowHandle As IntPtr
Dim ChildAfter As IntPtr
Dim ListBoxHandle As IntPtr
'Get the FormHandle
MainWindowHandle = FindWindow(FormClass, FormCaption)
'Get the ChildAfter of the ListBox
ChildAfter = FindWindowEx(MainWindowHandle, IntPtr.Zero, ChildClass, ChildCaption)
'Get the handle of the ListBox
ListBoxHandle = FindWindowEx(MainWindowHandle, ChildAfter, TargetClass, TargetCaption)
'Send String to ListBox
SendMessageHM(ListBoxHandle, WM_SETTEXT, 0, TextBox1.Text)
Any suggestions is very much appreciated.
i try to make automatic key presser that make minimized game client do order for me while i work in other thing (aion game client) but nothing work here is the code i use please tell me what is wrong with it
Const WM_SETTEXT As Long = &HC
Const GW_CHILD As Long = 5
Declare Function GetWindow Lib "user32.dll" (ByVal hWnd As IntPtr, ByVal uCmd As Integer) As IntPtr
Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As IntPtr 'Int32
Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" ( _
ByVal hWnd As IntPtr, _
ByVal wMsg As Int32, _
ByVal wParam As Int32, _
ByVal lParam As String) As Int32
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim hWnd1 As IntPtr = FindWindow("AIONClientWndClass1.0", "AION Client")
Dim hWndR2 As IntPtr = GetWindow(hWnd1, GW_CHILD)
SendMessage(hWndR2, WM_SETTEXT, 0, "h")
End Sub
this is the code i use it must show window in the game when i click button1 , but nothing happen
i use visual studio 2013 and windows 10 64 bit
here is my wrong
1st my app need to run as administrator
2nd have to set target cpu to 86x
3rd i fixed my code , and here it is
Const WM_SETTEXT As Long = &HC
Const GW_CHILD = 5
Const WM_KEYDOWN As Integer = &H100
Const WM_KEYUP As Integer = &H101
Declare Function GetWindow Lib "user32.dll" (ByVal hWnd As IntPtr, ByVal uCmd As Integer) As IntPtr
Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As IntPtr 'Int32
Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hWnd As IntPtr,ByVal wMsg As Int32,ByVal wParam As Int32,ByVal lParam As IntPtr) As IntPtr
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim _hndl As IntPtr = FindWindow("AIONClientWndClass1.0", "AION Client")
SendMessage(_hndl, WM_KEYDOWN, &H55, 0)
End Sub
&H55 is virtual key code = u
I want to detect currently opened swf file name. Here is my code:
Private Const GW_HWNDNEXT = 2
Private Declare Function GetWindow Lib "user32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName 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 Sub Form_Load()
ListWins "*.swf*"
End Sub
Sub ListWins(Optional Title = "*", Optional Class = "*")
Dim hWndThis As Long
hWndThis = FindWindow(vbNullString, vbNullString)
While hWndThis
Dim sTitle As String, sClass As String
sTitle = Space$(255)
sTitle = Left$(sTitle, GetWindowText(hWndThis, sTitle, Len(sTitle)))
sClass = Space$(255)
sClass = Left$(sClass, GetClassName(hWndThis, sClass, Len(sClass)))
If sTitle Like Title And sClass Like Class Then
Debug.Print sTitle, sClass
List1.AddItem (sTitle)
End If
hWndThis = GetWindow(hWndThis, GW_HWNDNEXT)
Wend
End Sub
This code is working fine to detect *.doc, *.xls files name, but not working on *.swf files.
NOTE
I have tested it in VBA. I am sure it will work in VB6 as well.
Try this (Paste this code in a module and run the Sub Sample)
Private Declare Function GetWindowTextLength Lib "user32" Alias _
"GetWindowTextLengthA" (ByVal HWnd 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 GetDesktopWindow Lib "user32" () As Long
Public Declare Function EnumChildWindows Lib "user32" _
(ByVal hWndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Public Function APIWindowCaption(ByVal HWnd As Long, ByVal lParam As Long) As Long
Static winnum As Integer
Dim MyStr As String
winnum = winnum + 1
MyStr = String(GetWindowTextLength(HWnd) + 1, Chr$(0))
GetWindowText HWnd, MyStr, Len(MyStr)
'~~> This will give you the caption of the window
If InStr(1, MyStr, ".swf", vbTextCompare) Then Debug.Print MyStr
APIWindowCaption = 1
End Function
Sub Sample()
Dim retval As Long, DesktophWnd As Long
DesktophWnd = GetDesktopWindow
retval = EnumChildWindows(DesktophWnd, AddressOf APIWindowCaption, ByVal 0&)
End Sub
SNAPSHOT