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
Related
So I have a method I am using to which I can integrate powerpoint into a panel. I use the FindWindow and SetParent functions to achieve this:
Dim proc as integer
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As Long) As Long
Private Declare Function SetParent Lib "user32" Alias "SetParent" (ByVal hWndChild As IntPtr, ByVal hWndNewParent As IntPtr) As Integer
Public Sub embed_Window()
Do Until proc <> 0
proc = FindWindow(vbNullString, window_name)
Loop
SetParent(proc, Panel1.Handle)
End Sub
This part works fine for embedding another window into my panel control. My question is, how can I close the window that is now in my panel? I can no longer use the FindWindow method as it is not a window in the task bar anymore.
In order to close an opened window you need to use PostMessage:
Private Declare Auto Function PostMessage Lib "user32" (ByVal hwnd As Integer, ByVal message As UInteger, ByVal wParam As Integer, ByVal lParam As Integer) As Boolean
Public Const WM_CLOSE = &H10
Public Sub CloseWindow()
PostMessage(proc, WM_CLOSE, 0, 0)
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'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
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
Can somebody explain how it can be that the same API call returns so much quicker with VB6 than with VB.NET?
Here is my VB6 code:
Public Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hWnd As Long) As Long
Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Public Function GetWindowTextEx(ByVal uHwnd As Long) As String
Dim lLen&
lLen = GetWindowTextLength(uHwnd) + 1
Dim sTemp$
sTemp = Space(lLen)
lLen = GetWindowText(uHwnd, sTemp, lLen)
Dim sRes$
sRes = Left(sTemp, lLen)
GetWindowTextEx = sRes
End Function
And here is my VB.NET code:
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Integer, ByVal lpWindowText As String, ByVal cch As Integer) As Integer
Dim sText As String = Space(Int16.MaxValue)
GetWindowText(hwnd, sText, Int16.MaxValue)
I ran each version 1000 times.
The VB6 version needed 2.04893359351538 ms.
The VB.NET version needed 372.1322491699365 ms.
Both Release and Debug version are about the same.
What is happening here?
Do not use the *A version, just skip the suffix, and use StringBuilder instead of String:
Private Declare Auto Function GetWindowText Lib "user32" (ByVal hwnd As Integer, ByVal lpWindowText As StringBuilder, ByVal cch As Integer) As Integer
Private Declare Function GetWindowTextLength Lib "user32" (ByVal hwnd As Integer) As Integer
Dim len As Integer = GetWindowTextLength (hwnd)
Dim str As StringBuilder = new StringBuilder (len)
GetWindowText (hwnd, str, str.Capacity)