VBA Postmessage ignoriert Shift
03.02.2026 14:55:23
W.Stecher
ich bitte zunächst um Entschuldigung für den neuen Beitrag, aber mein letzte Woche eröffneter Beitrag unter dem gleichen Titel scheint ins Archiv 2020to2024 verschoben worden zu sein!?!? Es ging darum, dass ich beim Aufruf der Remotedesktopverbindung per VBA das Passwort ins das Kennwortfeld eintragen wollte.
Zum einen wollte ich Volti noch eine Rückmeldung geben zu seinem Lösungsvorschlag, zum anderen hat sich das Problem seit heute thematisch verschoben.
Der Vorschlag von Volti hat bei mir nicht funktioniert, weil mit der Zeile
FindWindowExA(hDlg, ByVal 0&, "Button", "OK")die Schaltfläche nicht gefunden wurde.
Wäre zwar egal gewesen, denn das hätte ich mit Enter ersetzen können, aber ich habe es auch nach mehrtägigen Versuchen und Recherchen nicht geschafft, das Eingabefeld zu identifizieren.
Nach ganz viel weiterer Herumprobiererei habe ich nun eine dem Grunde nach funktionierende Lösung, die auch kein Shift mehr braucht, da für jedes Zeichen der Hexcode gesendet wird.
Problem: Sie funktioniert nur unter Windows 10.
Führe ich den Code unter Windows 11 aus, wird kein einziges Zeichen eingetragen.
Mal sehen, ob ich dazu auch noch die Ursache incl. Lösung finde. Falls jemand eine Idee hat, wäre ich sehr dankbar.
Diese Lösung funktioniert auf jeden Fall bei mir unter Windows 10, ich habe jedes einzelne Zeichen probiert:
Option Explicit
Private Declare PtrSafe Function GetDesktopWindow Lib "user32" () As Long
Private Declare PtrSafe Function GetWindow Lib "user32" ( _
ByVal hWnd As Long, _
ByVal wCmd As Long) As Long
Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" ( _
ByVal hWnd As Long, _
ByVal wIndx As Long) As Long
Private Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" ( _
ByVal hWnd As Long, _
ByVal lpString As String, _
ByVal cch As Long) As Long
Private Declare PtrSafe Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" ( _
ByVal hWnd As Long) As Long
Private Declare PtrSafe Function PostMessage Lib "user32.dll" Alias "PostMessageA" ( _
ByVal hWnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As LongPtr
Private Declare PtrSafe Function SetActiveWindow Lib "user32.dll" ( _
ByVal hWnd As Long) As LongPtr
Private Declare PtrSafe Function SetForegroundWindow Lib "user32" ( _
ByVal hWnd As Long) As LongPtr
Private Declare PtrSafe Sub Sleep Lib "kernel32" ( _
ByVal dwMilliseconds As LongPtr)
Private Const GWL_STYLE = (-16)
Private Const GW_CHILD = 5
Private Const GW_HWNDNEXT = 2
Public Function Testing()
'zum Test von Groß- und Kleinschreibung,
' Leer- und Sonderzeichen
Call PostPassword("3 Sonderzeichen: ! # |")
End Function
Public Function PostPassword(sPassword As String)
Const WM_CHAR = &H102
Dim hWnd As Long
Dim i As Byte
Do Until hWnd > 0
hWnd = GetWindowHandle("Windows-Sicherheit")
Sleep 1000
Loop
Call SetForegroundWindow(hWnd)
Call SetActiveWindow(hWnd)
Sleep 500
For i = 1 To Len(sPassword)
Call PostMessage(hWnd, WM_CHAR, HexCode(Mid(sPassword, i, 1)), 0)
Sleep 250
Next i
End Function
Private Function HexCode(sText As String) As Long
Select Case sText
Case " ": HexCode = &H20
Case "!": HexCode = &H21
Case """": HexCode = &H22
Case "#": HexCode = &H23
Case "$": HexCode = &H24
Case "%": HexCode = &H25
Case "&": HexCode = &H26
Case "'": HexCode = &H27
Case "(": HexCode = &H28
Case ")": HexCode = &H29
Case "*": HexCode = &H2A
Case "+": HexCode = &H2B
Case ",": HexCode = &H2C
Case "-": HexCode = &H2D
Case ".": HexCode = &H2E
Case "/": HexCode = &H2F
Case "0": HexCode = &H30
Case "1": HexCode = &H31
Case "2": HexCode = &H32
Case "3": HexCode = &H33
Case "4": HexCode = &H34
Case "5": HexCode = &H35
Case "6": HexCode = &H36
Case "7": HexCode = &H37
Case "8": HexCode = &H38
Case "9": HexCode = &H39
Case ":": HexCode = &H3A
Case ";": HexCode = &H3B
Case "": HexCode = &H3C
Case "=": HexCode = &H3D
Case ">": HexCode = &H3E
Case "?": HexCode = &H3F
Case "@": HexCode = &H40
Case "A": HexCode = &H41
Case "B": HexCode = &H42
Case "C": HexCode = &H43
Case "D": HexCode = &H44
Case "E": HexCode = &H45
Case "F": HexCode = &H46
Case "G": HexCode = &H47
Case "H": HexCode = &H48
Case "I": HexCode = &H49
Case "J": HexCode = &H4A
Case "K": HexCode = &H4B
Case "L": HexCode = &H4C
Case "M": HexCode = &H4D
Case "N": HexCode = &H4E
Case "O": HexCode = &H4F
Case "P": HexCode = &H50
Case "Q": HexCode = &H51
Case "R": HexCode = &H52
Case "S": HexCode = &H53
Case "T": HexCode = &H54
Case "U": HexCode = &H55
Case "V": HexCode = &H56
Case "W": HexCode = &H57
Case "X": HexCode = &H58
Case "Y": HexCode = &H59
Case "Z": HexCode = &H5A
Case "[": HexCode = &H5B
Case "\": HexCode = &H5C
Case "]": HexCode = &H5D
Case "^": HexCode = &H5E
Case "_": HexCode = &H5F
Case "`": HexCode = &H60
Case "a": HexCode = &H61
Case "b": HexCode = &H62
Case "c": HexCode = &H63
Case "d": HexCode = &H64
Case "e": HexCode = &H65
Case "f": HexCode = &H66
Case "g": HexCode = &H67
Case "h": HexCode = &H68
Case "i": HexCode = &H69
Case "j": HexCode = &H6A
Case "k": HexCode = &H6B
Case "l": HexCode = &H6C
Case "m": HexCode = &H6D
Case "n": HexCode = &H6E
Case "o": HexCode = &H6F
Case "p": HexCode = &H70
Case "q": HexCode = &H71
Case "r": HexCode = &H72
Case "s": HexCode = &H73
Case "t": HexCode = &H74
Case "u": HexCode = &H75
Case "v": HexCode = &H76
Case "w": HexCode = &H77
Case "x": HexCode = &H78
Case "y": HexCode = &H79
Case "z": HexCode = &H7A
Case "{": HexCode = &H7B
Case "|": HexCode = &H7C
Case "}": HexCode = &H7D
Case "~": HexCode = &H7E
End Select
End Function
Private Function GetWindowHandle(sWindowTitle As String) As Long
Dim hWnd As Long
Dim bFound As Boolean
Dim sTitel As String
bFound = False
hWnd = GetWindow(GetDesktopWindow, GW_CHILD)
Do
sTitel = GetWindowInfo(hWnd)
If InStr(1, sTitel, sWindowTitle, vbTextCompare) > 0 Then
bFound = True
Exit Do
End If
hWnd = GetWindow(hWnd, GW_HWNDNEXT)
Loop Until hWnd = 0
If bFound = True Then
GetWindowHandle = hWnd
Else
GetWindowHandle = 0
End If
End Function
Private Function GetWindowInfo(ByVal hWnd As Long) As String
Dim lngResult As Long
Dim lngStyle As Long
Dim sTitle As String
lngStyle = GetWindowLong(hWnd, GWL_STYLE)
' Titel des Fenster auslesen
lngResult = GetWindowTextLength(hWnd) + 1
sTitle = Space$(lngResult)
lngResult = GetWindowText(hWnd, sTitle, lngResult)
sTitle = Left$(sTitle, Len(sTitle) - 1)
If sTitle > "" And sTitle > "Default IME" And sTitle > "GDI+ Window" And sTitle > "MSCTFIME UI" And _
sTitle > "Hidden Window" And sTitle > "GlowWindow" And sTitle > "DDE Server Window" And Left(sTitle, 26) > ".NET-BroadcastEventWindow." Then
GetWindowInfo = sTitle
Else
GetWindowInfo = "X"
End If
End Function
Anzeige