AW: Probleme mit Public Declare PtrSafe
10.07.2022 14:17:07
Micha
Das hier ist der Code, den ich umgebaut habe:
Option Explicit
#If VBA7 And Win64 Then
Public Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As LongPtr, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As LongPtr
Public Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As LongPtr
Public Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
(ByVal hWnd1 As LongPtr, _
ByVal hWnd2 As LongPtr, _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As LongPtr
Public 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
Public Declare PtrSafe Function PostMessage Lib "user32" Alias "PostMessageA" _
(ByVal hwnd As LongPtr, _
ByVal wMsg As Long, _
ByVal wParam As LongPtr, _
ByVal lParam As LongPtr) As Long
#Else
Public 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 nShowCmd As Long) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
(ByVal hWnd1 As Long, _
ByVal hWnd2 As Long, _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Public 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
#End If
Public Const SW_HIDE As Long = 0
Public Const SW_SHOWNORMAL As Long = 1
Public Const SW_SHOWMAXIMIZED As Long = 3
Public Const SW_SHOWMINIMIZED As Long = 2
Public Const WM_SETTEXT = &HC
Public Const VK_RETURN = &HD
Public Const WM_KEYDOWN = &H100
Public Sub OpenLockedPdf()
#If VBA7 And Win64 Then
Dim parentWindow As LongPtr
Dim firstChildWindow As LongPtr
#Else
Dim parentWindow As Long
Dim firstChildWindow As Long
#End If
Dim timeCount As Date
timeCount = Now()
Do Until Now() > timeCount + TimeValue("00:00:05")
parentWindow = 0
DoEvents
parentWindow = FindWindow("#32770", "PDF-Datei speichern unter")
If parentWindow 0 Then Exit Do
Loop
If parentWindow 0 Then
'Child Window
timeCount = Now()
Do Until Now() > timeCount + TimeValue("00:00:05")
firstChildWindow = 0
DoEvents
firstChildWindow = FindWindowEx(parentWindow, ByVal 0&, "DUIViewWndClassName", vbNullString)
If firstChildWindow 0 Then Exit Do
Loop
If fifthChildfourthWindow 0 Then
'OK button (default)
PostMessage firstChildWindow, WM_KEYDOWN, VK_RETURN, 0
End If
End If
End Sub
Das Gleiche passiert aber z.B. auch, wenn ich den nachstehenden Code für einen Timer nutzen möchte:
Attribute VB_Name = "Timer"
#If VBA7 Then
Private Declare PtrSafe Function SetTimer Lib "user32" ( _
ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr, _
ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
Private Declare PtrSafe Function KillTimer Lib "user32" ( _
ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
Private lngStart As LongPtr
#Else
Private Declare Function SetTimer Lib "user32" ( _
ByVal hWnd As Long, ByVal nIDEvent As Long, _
ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" ( _
ByVal hWnd As Long, ByVal nIDEvent As Long) As Long
Private lngStart As Long
#End If
Public Sub TimerAn() '(ByVal strName As String) '(ByVal msInterval As Long)
Dim msInterval As Long
Dim Sekunden As Long
Sekunden = 1
msInterval = Sekunden * 1000
Debug.Print "Start1: " & Time
lngStart = 0
SetTimer 0, 0, msInterval, AddressOf Uhr10s
End Sub
Public Sub Uhr10s(ByVal hWnd As LongPtr, ByVal uMsg As LongPtr, _
ByVal wParam As LongPtr, ByVal lParam As LongPtr)
Dim StartZeit As String
StartZeit = Format(Now, "hh:mm:ss;@")
Dim LaufzeitSekunden As Long
Dim Laufzeit As Long
LaufzeitSekunden = 1
Laufzeit = LaufzeitSekunden * 1000
Select Case lngStart
Case 0 '''Startzeitpunkt merken
lngStart = lParam
Debug.Print "Start2: " & Time
Case Is