title image


Smiley Re: E97: API: Tastenkombi per Sendmessage an Fenster-Handle
Huhu Micha,



Herzlichen Dank (!!!) für die Hilfe!! Funktioniert. Well, nicht ganz wie gehofft - aber so gut, wie eben möglich. Immerhin habe ich bestimmt jetzt einen ganzen Tag mit der Suche zugebracht. Mir ist zwar immer noch nicht so gar klar, weshalb die Sendmessage-Funktion wohl nicht verwendbar ist, um die Zeichenfolge "Alt + S" zu senden. Und wieso bei Postmessage die Alt-Taste in den LParam übernommen wird. Und schade auch, dass die Postmessage-Funktion ein im Vordergrund befindliches Fenster erwartet. Ich hätte gehofft, dass mit Postmessage anders als mit Sendkeys "{%S}" eine *stabile* Übertragung an das per Handle bezeichnete Fenster im Hintergrund möglich gewesen wäre. Tatsächlich unterscheidet sich die Funktion wohl wenig von Sendkeys. Sie ermöglicht aber immerhin, auch später noch selektiv auf Fenster zuzugreifen. Als kleinen Dank nachstehend das gesamte Script (Mailversand mit Outlook ohne Sicherheitsfrage:



'Modul1:

Option Explicit

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



Declare Function SetFocusWnd Lib "user32.dll" Alias "SetFocus" _

(ByVal hwnd As Long) As Long



Private Declare Sub Sleep Lib "kernel32" _

(ByVal dwMilliseconds As Long)



Declare Function EnumProcesses Lib "psapi.dll" _

(ByRef lpidProcess As Long, ByVal cb As Long, _

ByRef cbNeeded As Long) As Long



Declare Function GetModuleFileNameExA Lib "psapi.dll" _

(ByVal hProcess As Long, ByVal hModule As Long, _

ByVal ModuleName As String, _

ByVal NameSizeM As Long) As Long



Declare Function EnumProcessModules Lib "psapi.dll" _

(ByVal hProcess As Long, ByRef lphModule As Long, _

ByVal cb As Long, _

ByRef cbNeeded 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



Declare Function OpenProcess Lib "Kernel32.dll" _

(ByVal dwDesiredAccessas As Long, _

ByVal bInheritHandle As Long, _

ByVal dwProcId As Long) As Long



Private Declare Function GetWindowThreadProcessId Lib "user32" _

(ByVal hwnd As Long, _

ByRef lpdwProcessId As Long) As Long



Declare Function EnumWindows Lib "user32" _

(ByVal lpEnumFunc As Long, _

ByVal lParam As Long) As Long



Private Const MAX_PATH = 260

Private Const PROCESS_TERMINATE = &H1



Private Const STANDARD_RIGHTS_REQUIRED = &HF0000

Private Const SYNCHRONIZE = &H100000

Private Const PROCESS_ALL_ACCESS = STANDARD_RIGHTS_REQUIRED _

Or SYNCHRONIZE Or &HFFF



Private Const VK_MENU = &H12

Private Const WM_SYSKEYDOWN = &H104

Private Const WM_SYSKEYUP = &H105

Const WM_KEYDOWN = &H100: Const WM_KEYUP = &H101



Private Type WindowInfo

hwnd As Long

ProcID As Long

WinTitleName As String

End Type



Private TopWindowCount As Integer

Private WindowInfoArray() As WindowInfo

Function EnumWinProc(ByVal lHwnd As Long, ByVal lParam As Long) As Long



Dim RetVal As Long, ThreadId As Long, ProcessId As Long

Dim WinTitleBuf As String * 255

Dim WinClass As String, WinTitle As String

Dim Fenstertitel$

Fenstertitel = "Test"



RetVal = GetWindowText(lHwnd, WinTitleBuf, 255)

WinTitle = Left(WinTitleBuf, Len(WinTitleBuf) - 1)



ThreadId = GetWindowThreadProcessId(lHwnd, ProcessId)



TopWindowCount = TopWindowCount + 1 'Platz für nächstes Window schaffen

ReDim Preserve WindowInfoArray(1 To TopWindowCount)



With WindowInfoArray(TopWindowCount)

.hwnd = lHwnd 'Window handle

.ProcID = ProcessId 'Process ID des Processes, zu dem das Window gehört

.WinTitleName = WinTitle 'Window Title

If InStr(1, WinTitle, Fenstertitel, vbTextCompare) Then

SetFocusWnd (lHwnd)

Sleep 100

Call PostMessage(lHwnd, WM_SYSKEYDOWN, Asc("S"), &H20000001)

Sleep 500

End If

End With



EnumWinProc = True



End Function

Public Function Hotkey_Senden() As Boolean



Dim lRet As Long, i As Long, j As Long, lParam As Long

Dim ArraySizeP As Long, BytesNeededP As Long, NumProcesses As Long

Dim ArraySizeM As Long, BytesNeededM As Long, NameSizeM As Long

Dim ProcessIDs(1 To 256) As Long

Dim Modules(1 To 128) As Long

Dim ModuleName As String

Dim hProcess As Long



ArraySizeP = 1024 'entspricht 256 Prozessen

ArraySizeM = 512 'entspricht 128 Modulen pro Prozess

lRet = EnumProcesses(ProcessIDs(1), ArraySizeP, BytesNeededP)



NumProcesses = BytesNeededP / 4 'Anzahl der Processe = Anzahl der Bytes / 4

lRet = EnumWindows(AddressOf EnumWinProc, lParam) 'Windows auflisten



End Function



'modul2:

Option Explicit

Declare Function FindWindow Lib "user32" _

Alias "FindWindowA" ( _

ByVal lpClassName As String, _

ByVal lpWindowName As String) 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 Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)



Declare Function SetFocusWnd Lib "user32.dll" Alias "SetFocus" _

(ByVal hwnd As Long) As Long



Private Const VK_MENU = &H12

Private Const WM_SYSKEYDOWN = &H104

Private Const WM_SYSKEYUP = &H105

Const WM_KEYDOWN = &H100: Const WM_KEYUP = &H101

Public Sub senden()

On Error GoTo Fehler

Dim lHwnd, lRetVal As Long

Dim intCounter%

Dim objOutlook As Outlook.Application

Dim objOutlookMsg As Outlook.MailItem



Set objOutlook = CreateObject("Outlook.Application")



intCounter = 1



For intCounter = 2 To 400

Set objOutlookMsg = objOutlook.CreateItem(olMailItem)

With objOutlookMsg

.To = "test@nix.nix"

.Subject = "Test"

.Body = "Test"

.Display



lHwnd = FindWindow(vbNullString, objOutlook.ActiveInspector.Caption)



If lHwnd Then

SetFocusWnd (lHwnd)

Call PostMessage(lHwnd, WM_SYSKEYDOWN, Asc("S"), &H20000001)

Sleep 75

End If

End With



If intCounter Mod 50 = 0 Then

Hotkey_Senden

Hotkey_Senden

DoEvents

Sleep 5000

DoEvents

End If



Next intCounter

Set objOutlook = Nothing

Hotkey_Senden

Hotkey_Senden

Hotkey_Senden

Exit Sub



Fehler:

If Err.Number > 0 Then

MsgBox Err.Number

MsgBox Err.Description

Resume Next

End If

Application.ScreenUpdating = True



End Sub



Nochmals Danke!



Viele Grüße



Björn



geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: