I have been searching for a way to close windows explorer using vba, and i have found something that works. However i actually have no idea what it is actually doing, or what any of it means. Could someone please explain what is happening below?
Private Const CLOSE_WIN = &H10
Dim Hwnd As Long
Private Declare Function apiFindWindow _
Lib "user32" Alias "FindWindowA" _
(ByVal lpClassname As String, _
ByVal lpWindowName As String) _
As Long
Private Declare Function apiPostMessage _
Lib "user32" Alias "PostMessageA" _
(ByVal Hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) _
As Long
Hwnd = apiFindWindow("CabinetWClass", vbNullString)
Dim retval As Long
If (Hwnd) Then
retval = apiPostMessage(Hwnd, CLOSE_WIN, 0, ByVal 0&)
End If
Thank You
Related
I'd like to convert VBA macro to Google Apps script but I think this particular one is impossible to convert as I am totally lost where to begin with this. I couldn't find anyway to do what "findwindow" does on APP script. Does anyone have any idea how to tackle this or should I give up on this?
Plus, is there anyone played with the phone companion? As they don't provide any API, the only way to use the mobile companion to send messages with google spread would be using findwindow, which shows the same problem. Any insight on this would be highly appreciated. Thanks.
Option Explicit
#If VBA7 Then
' https://learn.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-findwindowa
Private Declare PtrSafe Function FindWindow Lib "user32.dll" Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
' https://learn.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-findwindowexa
Public Declare PtrSafe Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" _
(ByVal hwndParent As Long, _
ByVal hwndChildAfter As Long, _
ByVal lpszClass As String, _
ByVal lpszWindow As String) As Long
' https://learn.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-sendmessagea
Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByRef lParam As Any) As Long
'https://learn.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-postmessagea
Private Declare PtrSafe Function PostMessage Lib "user32" Alias "PostMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByRef lParam As Any) As Long
Private Declare PtrSafe Function GetNextWindow Lib "user32" Alias "GetWindow" (ByVal hwnd As Long, ByVal wFlag As Long) As Long
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal Milliseconds As LongPtr)
#Else
' https://learn.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-findwindowa
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
' https://learn.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-findwindowexa
Public Declare Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" _
(ByVal hwndParent As Long, _
ByVal hwndChildAfter As Long, _
ByVal lpszClass As String, _
ByVal lpszWindow As String) As Long
' https://learn.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-sendmessagea
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByRef lParam As Any) As Long
'https://learn.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-postmessagea
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByRef lParam As Any) As Long
>Private Declare Function GetNextWindow Lib "user32" Alias "GetWindow" (ByVal hwnd As Long, ByVal wFlag As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal Milliseconds As LongPtr)
#End If
Dim Handle, HandleEx As Long
Private Const WM_SETTEXT = &HC: Private Const WM_KEYDOWN = &H100
Private Const VK_RETURN = &HD: Private Const VK_ESCAPE = &H1B
Private Const WM_CLOSE = &H10: Private Const GW_HWNDNEXT = &H2
Sub Send_Kakao(Target As Range, Msg As Range)
Dim SendTo$: SendTo = Target.Value
Dim Message$: Message = Msg.Value
Dim hwnd_KakaoTalk As Long: Dim hwnd_RichEdit As Long
Call Call_ChatRoom(Target)
DoEvents
Sleep 1000
hwnd_KakaoTalk = FindWindow(vbNullString, SendTo)
hwnd_RichEdit = FindWindowEx(hwnd_KakaoTalk, 0, "RichEdit50W", vbNullString)
If hwnd_RichEdit = 0 Then MsgBox SendTo & "This chatroom is not opened.": Exit Sub
Call SendMessage(hwnd_RichEdit, WM_SETTEXT, 0, ByVal Message)
Call PostMessage(hwnd_RichEdit, WM_KEYDOWN, VK_RETURN, 0)
End Sub
Private Sub Call_ChatRoom(Target As Range)
Dim ChatRoom$: ChatRoom = Target.Value
Dim rtnV As Long
Handle = FindWindow("EVA_Window_Dblclk", vbNullString) 'Saave Window Handle info of Kakao on Handle
'//Print error when cannot be located
If Handle = 0 Then
MsgBox "Open kakao first.", 16, "Error"
Else
HandleEx = FindWindowEx(Handle, 0, "EVA_ChildWindow", vbNullString) 'children Window1
HandleEx = FindWindowEx(HandleEx, 0, "EVA_Window", vbNullString) 'children Window2
HandleEx = FindWindowEx(HandleEx, 0, "Edit", vbNullString) 'children Window3
Call SendMessage(HandleEx, WM_SETTEXT, 0, ByVal ChatRoom)
DoEvents
Sleep 1000
Call PostMessage(HandleEx, WM_KEYDOWN, VK_RETURN, 0)
End If
End Sub
I am trying to send WM_KEYDOWN and WM_KEYUP to notepad's edit control. The following example works, if I send a VK_F5: Notepad inserts the current date and time. However, If I try to send a simple h, notepad doesn't stop inserting one h after another so that I have to kill notepad with the task manager.
I don't understand why it works with one key and not with the other and I'd like to know what I have to change to send a simple letter.
option explicit
const WM_KEYDOWN = &h0100
const WM_KEYUP = &h0101
const VK_F5 = &h074
declare function FindWindow lib "user32" alias "FindWindowA" ( _
byVal lpClassName as string, _
byVal lpWindowName as string) as long
declare function FindWindowEx lib "user32" alias "FindWindowExA" ( _
byVal hWnd as long , _
byVal hWndChildAfter as long , _
byVal lpClassName as string, _
byVal lpWindowName as string) as long
declare function MapVirtualKey lib "user32" alias "MapVirtualKeyA" ( _
byVal wCode as long, _
byVal wMapType as long) as long
declare function PostMessage lib "user32" alias "PostMessageA" ( _
byVal hwnd as long, _
byVal wMsg as long, _
byVal wParam as long, _
lParam as any) as long
declare function ShellExecute Lib "shell32.dll" alias "ShellExecuteA" ( _
byVal hwnd as long , _
byVal lpOperation as string, _
byVal lpFile as string, _
byVal lpParameters as string, _
byVal lpDirectory as string, _
byval lpShowCmd as long) as long
declare sub Sleep lib "kernel32" (byVal dwMilliseconds as long )
sub main()
dim hWndNotepad as long
dim hWndNotepadEdit as long
'
' Start notepad
'
ShellExecute 0, "Open", "notepad.exe", "", "", 1
'
' Find the window handle for notepad
'
hWndNotepad = FindWindow("notepad", vbNullString)
while hWndNotepad = 0
'
' Wait a while if notepad window not yet initialized:
'
Sleep 100
hWndNotepad = FindWindow("notepad", vbNullString)
wend
'
' Find the window handle of the edit control
' in notepad:
'
hWndNotepadEdit = FindWindowEx(hWndNotepad, 0, "Edit", vbNullString)
dim vkCode as long
' This works:
' ----------
'
' vkCode = VK_F5
'
' This doesn't:
' ------------
vkCode = asc("H")
dim lParam as long
lParam = 1 + MapVirtualKey(vkCode, 0) * 2^16
PostMessage hWndNotepadEdit, WM_KEYDOWN, vkCode, lParam
Sleep 100
PostMessage hWndNotepadEdit, WM_KEYUP , vkCode, lParam or &hc0000000
end sub
You have a bug in declaration of PostMessage function (lParam as Any)
Correct is ByVal lParam as Long
Option Explicit
Const WM_KEYDOWN = &H100
Const WM_CHAR = &H102
Const WM_KEYUP = &H101
Const VK_F5 = &H74
Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" ( _
ByVal hwnd As Long, _
ByVal hWndChildAfter As Long, _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Declare Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" ( _
ByVal wCode As Long, _
ByVal wMapType As Long) As Long
Declare Function PostMessage Lib "user32" Alias "PostMessageA" ( _
ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
ByVal hwnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal lpShowCmd As Long) As Long
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub main()
Dim hWndNotepad As Long
Dim hWndNotepadEdit As Long
'
' Start notepad
'
ShellExecute 0, "Open", "notepad.exe", "", "", 1
'
' Find the window handle for notepad
'
hWndNotepad = FindWindow(vbNullString, "Bez názvu – Poznámkový blok")
While hWndNotepad = 0
'
' Wait a while if notepad window not yet initialized:
'
Sleep 100
hWndNotepad = FindWindow(vbNullString, "Bez názvu – Poznámkový blok")
Wend
'
' Find the window handle of the edit control
' in notepad:
'
hWndNotepadEdit = FindWindowEx(hWndNotepad, 0, "Edit", vbNullString)
Dim vkCode As Long
' This works:
' ----------
'
' vkCode = VK_F5
'
' This doesn't:
' ------------
vkCode = Asc("H")
Dim lParam As Long
lParam = 1 + MapVirtualKey(vkCode, 0) * (2 ^ 16)
Debug.Print Hex(vkCode), Hex(lParam)
PostMessage hWndNotepadEdit, WM_KEYDOWN, vkCode, lParam
' PostMessage hWndNotepadEdit, WM_KEYUP, vkCode, lParam Or &HC0000000
End Sub
You can send simple letters as well as other characters in hex format. For simple h it is Const VK_H = &H48. Some other examples:
Const VK_NUMPAD0 = &H60
Const VK_NUMPAD1 = &H61
Const VK_NUMPAD2 = &H62
VK_A thru VK_Z are the same as their ASCII equivalents: 'A' thru 'Z'
VK_0 thru VK_9 are the same as their ASCII equivalents: '0' thru '9'
Source WIN32_API.
If I understand correctly, problem is that the numbers do not always match the "real" hex numbers for ASCII.
I want to locate an recently opened pdf file and save it in a target folder, right now i can able to locate the pdf file using its name and close it but i want to use Save As function.
Code tried to Locate and close the PDF
Option Explicit
Private Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function PostMessage Lib "user32" _
Alias "PostMessageA" (ByVal hwnd As Long, _
ByVal wMsg As Long, ByVal wParam As Long, _
ByVal lParam As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" _
(ByVal dwDesiredAccess As Long, _
ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long) As Long
Private Declare Function GetWindowThreadProcessId _
Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Declare Function GetParent 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 GetWindow Lib "user32" (ByVal hwnd As Long, _
ByVal wCmd As Long) As Long
Const GW_HWNDNEXT = 2
Const WM_CLOSE = &H10
Const SYNCHRONIZE = &H100000
Public Sub Test()
Dim hWindow As Long
Dim hProcess As Long
Dim lProcessId As Long
Dim lngReturnValue As Long
hWindow = SearchHndByWndName_Parent("vieworder.pdf.php")
hProcess = OpenProcess(SYNCHRONIZE, 0&, lProcessId)
lngReturnValue = PostMessage(hWindow, WM_CLOSE, 0&, 0&)
End Sub
Private Function SearchHndByWndName_Parent(strSearch As String) As Long
Dim strTMP As String * 100
Dim nhWnd As Long
nhWnd = FindWindow(vbNullString, vbNullString)
Do While Not nhWnd = 0
If GetParent(nhWnd) = 0 Then
GetWindowText nhWnd, strTMP, 100
If InStr(strTMP, strSearch) > 0 Then
SearchHndByWndName_Parent = nhWnd
Exit Do
End If
End If
nhWnd = GetWindow(nhWnd, GW_HWNDNEXT)
Loop
End Function
I am working in a restricted environment so I cant add any Adobe dll as reference, also the file which i am looking for is not yet saved in any folder.
Please share your suggestions.
Thank You
I found a piece of code that enables my User form list boxes to resize in height based on the number of inputs, but the declaration is for win32 and i do not know how to change it to win 64 correctly, please help. Here it is:
Option Explicit
Private Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, ByVal lParam As Any) As Long
Private Const LB_GETITEMHEIGHT = &H1A1
Public Function AutoSizeLBHeight(LB As Object) As Boolean
If Not TypeOf LB Is ListBox Then Exit Function
On Error GoTo ErrHandler
Dim lItemHeight As Long
Dim lRet As Long
Dim lItems As Long
Dim sngTwips As Single
Dim sngLBHeight As Single
If LB.ListCount = 0 Then
LB.Height = 125
AutoSizeLBHeight = True
Else
lItems = LB.ListCount
lItemHeight = SendMessage(LB.hwnd, LB_GETITEMHEIGHT, 0&, 0&)
If lItemHeight > 0 Then
sngTwips = lItemHeight * Screen.TwipsPerPixelY
sngLBHeight = (sngTwips * lItems) + 125
LB.Height = sngLBHeight
AutoSizeLBHeight = True
End If
End If
ErrHandler:
End Function
http://www.jkp-ads.com/articles/apideclarations.asp has everything you need.
The SendMessage API is a good example because it uses both types:
32-bit:
Public Declare Function SendMessageA Lib "user32" ( _
ByVal hWnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, lParam As Any) As Long
64 bit:
Public Declare PtrSafe Function SendMessageA Lib "user32" ( _
ByVal hWnd As LongPtr, ByVal wMsg As Long, _
ByVal wParam As Long, lParam As Any) As LongPtr
The first argument -hWnd- is a window handle, which is an address in memory. The return value is a pointer to a function, which is also an address in memory. Both of these must be declared LongPtr in 64-bit VBA. The arguments wMsg and wParam are used to pass data, so they can be Long in both 32-bit and 64-bit.
But you are aware that you only need this for 64bit-Excel, not for 64bit-Windows?
Using Compiler Directives will allow the code to run properly on either platform.
#If Win64 Then
Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As LongPtr, ByVal wMsg As Long, _
ByVal wParam As LongPtr, lParam As Any) As LongPtr
#ElseIf Win32 Then
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
#End If
A friend of mine made this Excel VBA code for me a while ago. It's 32bit, but now I need it converted for 64bit.
Can anyone please help me to do so?
Private Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLong Lib "user32.dll" _
Alias "GetWindowLongA" ( _
ByVal hWnd As Long, _
ByVal nIndex As Long) As Long
Private Declare Function SetWindowsHookEx Lib "user32" _
Alias "SetWindowsHookExA" ( _
ByVal idHook As Long, _
ByVal lpfn As Long, _
ByVal hmod As Long, _
ByVal dwThreadId As Long) As Long
Private Declare Function CallNextHookEx Lib "user32" ( _
ByVal hHook As Long, _
ByVal nCode As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" ( _
ByVal hHook As Long) As Long
Private Declare Function PostMessage Lib "user32.dll" _
Alias "PostMessageA" ( _
ByVal hWnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Private Declare Function WindowFromPoint Lib "user32" ( _
ByVal xPoint As Long, _
ByVal yPoint As Long) As Long
Private Declare Function GetCursorPos Lib "user32.dll" ( _
ByRef lpPoint As POINTAPI) As Long
You need to use "PtrSafe" when declaring function :
Private Declare PtrSafe Function
Also in 64bit Excel, use LongLong instead of Long
and LongPtr for callback functions
but for ptrSafe compiler itself will warn you if this is missing