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
Related
I recently changed Windows.
When I run my VBA code I get the following message:
'Place this code in a Module
Private Declare Function FindWindowA Lib "USER32" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLongA Lib "USER32" _
(ByVal hWnd As Long, _
ByVal nIndex As Long) As Long
Private Declare Function SetWindowLongA Lib "USER32" _
(ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
You should add a precompile If statement to work with Win 32 and 64.
The code below will make this work in Windows 32 and 64 bit systems.
Option Explicit
#If Win64 Then
Private Declare PtrSafe Function FindWindowA Lib "USER32" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare PtrSafe Function GetWindowLongA Lib "USER32" _
(ByVal hWnd As Long, _
ByVal nIndex As Long) As Long
Private Declare PtrSafe Function SetWindowLongA Lib "USER32" _
(ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
#Else
Private Declare Function FindWindowA Lib "USER32" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLongA Lib "USER32" _
(ByVal hWnd As Long, _
ByVal nIndex As Long) As Long
Private Declare Function SetWindowLongA Lib "USER32" _
(ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
#End If
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 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
This function is getting me crazy! I am trying to use SetWindwosHookEx to avoid some keystrokes from the user, but I can't make it work properly.
I have been looking around many code on the web but I don't understand why it is not working for me. Firstly, it was because I was using Excel 2010 (64 bit) and my code wasn't for it, but now I don't know.
Basically, I have created a simple code which shows me a message when I pull "g" but what it is happening is Excel crashes when a pull any key. It doesn't crash when I run the code step by step but if I pull "g" the message appears three times!
This is my code:
#If Win64 Then
Public Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) As LongPtr
Public Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As LongPtr, ByVal lpFn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As LongPtr) As LongPrt
Public Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal nCode As LongPtr, ByVal wParam As LongPtr, lParam As Any) As LongPtr
Public Declare PtrSafe Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As LongPtr
Public Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As LongPtr
Public Declare PtrSafe Function GetKeyState Lib "user32" (ByVal nVirtKey As LongPtr) As Integer
Private hWndPPT As LongPtr
Private HookHandle As LongPtr
'ADICIONAL
Private Declare Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" (ByVal hDlg As LongPrt, ByVal nIDDlgItem As LongPtr, ByVal wMsg As LongPtr, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As LongPtr) As LongPtr
#Else
Public Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Public 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
Public Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Public Declare Function GetCurrentThreadId Lib "kernel32" () As Long
Public Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Private hWndPPT As Long
Private HookHandle As Long
'ADICIONAL
Private Declare Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
#End If
'Constants to be used in our API functions
'Private Const EM_SETPASSWORDCHAR = &HCC
'Private Const WH_CBT = 5
Private Const WH_KEYBOARD = 2
'Private Const HCBT_ACTIVATE = 5
Private Const HC_ACTION = 0
'Private hHook As Long
Public Sub RemoveHook()
UnhookWindowsHookEx (HookHandle)
End Sub
Sub SetHook()
#If Win64 Then
Dim lThreadID As LongPtr
Dim lngModHwnd As LongPtr
#Else
Dim lThreadID As Long
Dim lngModHwnd As Long
#End If
lThreadID = GetCurrentThreadId
lngModHwnd = GetModuleHandle(vbNullString)
'Set a local hook
HookHandle = SetWindowsHookEx(WH_KEYBOARD, AddressOf NewProc, 0, lThreadID)
End Sub
Public Function NewProc(ByVal lngCode As LongPtr, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
If lngCode < HC_ACTION Then
NewProc = CallNextHookEx(HookHandle, lngCode, wParam, lParam)
Exit Function
End If
If wParam = 71 Then
'MsgBox "g"
'NewProc = 1
wParam = 70
'Exit Function
End If
'This line will ensure that any other hooks that may be in place are
'called correctly.
CallNextHookEx HookHandle, lngCode, wParam, lParam
End Function
The correct declarations for 64bit would be:
Public Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) As Long
Public Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpFn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As Long) As LongPtr
Public Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal nCode As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
Public Declare PtrSafe Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As LongPtr
Public Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long
Public Declare PtrSafe Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Private Declare PtrSafe Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" (ByVal hDlg As LongPtr, ByVal nIDDlgItem As Long, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
I can't actually see how the code you posted would run at all on 64bit.
I am working on converting some very old VBA code to run on AutoCAD 2014. I have so far converted everything but there is an issue with the forms (they are modeless and require an activation callback to modify the window propertis). The following is the VBA6 source code:
IN THE FORM:
Private Sub UserForm_Activate()
#If ACAD2000 = 0 Then
If Not bPopup Then
Call EnumWindows(AddressOf EnumWindowsProc, vbNull)
Call SubClass
bPopup = True
End If
#End If
End Sub
MODULE (named modModeLessFormFocus):
Option Explicit
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private ThisHwnd As Long
Public Const GWL_STYLE = -16
Public Const WS_POPUP = &H80000000
Function EnumWindowsProc(ByVal hwnd As Long, ByVal lParam As Long) As Integer
Dim title As String * 32
Call GetWindowText(hwnd, ByVal title, 32)
If InStr(title, "About") Then
ThisHwnd = hwnd
EnumWindowsProc = False
ElseIf InStr(title, "Preferences") Then
ThisHwnd = hwnd
EnumWindowsProc = False
ElseIf InStr(title, "Display Block Attributes") Then
ThisHwnd = hwnd
EnumWindowsProc = False
Else
EnumWindowsProc = True
End If
End Function
Public Function SubClass() As Long
Dim Flags As Long
Flags = GetWindowLong(ThisHwnd, GWL_STYLE)
Flags = Flags Xor WS_POPUP
SetWindowLong ThisHwnd, GWL_STYLE, Flags
End Function
The error I get when running is a "Type Mismatch" in UserForm_Activate on 'AddressOf EnumWindowsProc.' I have tried to convert it to 64bit using PtrSafe and PtrLong but inevitably it fails and the program crashes.
If anyone is smart enough to convert this or point me in the right direction I would be very appreciative.
Thanks
I found the API for 64-bit VBA7 in http://www.jkp-ads.com/articles/apideclarations.asp
#If VBA7 Then
#If Win64 Then
Private Declare PtrSafe Function GetWindowLongPtr Lib "USER32" Alias "GetWindowLongPtrA" (ByVal hWnd As LongPtr, ByVal nIndex As Long) As LongPtr
#Else
Private Declare PtrSafe Function GetWindowLongPtr Lib "USER32" Alias "GetWindowLongA" (ByVal hWnd As LongPtr, ByVal nIndex As Long) As LongPtr
#End If
Private Declare PtrSafe Function GetWindowText Lib "USER32" Alias "GetWindowTextA" _
(ByVal hWnd As LongPtr, ByVal lpString As String, _
ByVal cch As LongPtr) As Long
#Else
Private Declare Function GetWindowLongPtr Lib "USER32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex 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
#End If
You can also look at http://msdn.microsoft.com/en-us/library/aa383663(VS.85).aspx for the updated API