Migration PW-Verschlüsselung 64 Bit System
19.12.2016 15:57:39
JonnyBank855
Ich nutze folgendes Makro:
' Dieses Modul dient zur Verschlüsselung der Passworteingabe
Option Explicit
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 Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function GetWindow Lib "user32" ( _
ByVal hwnd As Long, _
ByVal wCmd 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
Private Declare Function SendMessageBynum& Lib "user32" Alias "SendMessageA" ( _
ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long)
Private Const gcClassnameMSDialog = "#32770"
Private Const gcClassnameMSExcel = "XLMAIN"
Private Const EM_SETPASSWORDCHAR = &HCC
Private Const GW_CHILD = 5&
Private Const GW_HWNDFIRST = 0&
Private Const GW_HWNDNEXT = 2&
Private strSearchCaption As String
Public Function fncPassword(strText As String, strCaption) As String
strSearchCaption = strCaption
Call prcSetTimer
fncPassword = InputBox(strText, strCaption)
End Function
Private Sub Passwordchar()
Dim lnghWnd As Long, lnghWnd1 As Long
Dim strClass As String
lnghWnd = FindWindow(gcClassnameMSDialog, strSearchCaption)
lnghWnd1 = GetWindow(lnghWnd, GW_CHILD)
Do
strClass = String(255, 0)
GetClassName lnghWnd1, strClass, 250
strClass = Left$(strClass, InStr(1, strClass, Chr(0)) - 1)
If LCase$(strClass) = "edit" Then SendMessageBynum lnghWnd1, _
EM_SETPASSWORDCHAR, 42, 0
lnghWnd1 = GetWindow(lnghWnd1, GW_HWNDNEXT)
Loop While lnghWnd1 0
End Sub
Private Sub prcSetTimer()
SetTimer FindWindow(gcClassnameMSExcel, vbNullString), 0, _
1000, AddressOf prcTimer
End Sub
Private Sub prcKillTimer()
KillTimer FindWindow(gcClassnameMSExcel, vbNullString), 0
End Sub
Private Sub prcTimer(ByVal hwnd As Long, ByVal nIDEvent As Long, _
ByVal uElapse As Long, ByVal lpTimerFunc As Long)
Call prcKillTimer
Call Passwordchar
End Sub
Das Makro funktioniert im Betrieb Windows Server 2011 (32 Bit) oder so und Office 2016 problemlos. Jetzt mit meinem neuen Rechner Windows 10 64 Bit und Office 2016 bekomme ich folgende Fehlermeldung: Fehler beim Kompilieren- Der Code in diesem Projekt muss für die Verwendung auf 64-Bit-Systeme aktualisiert werden. überarbeiten Sie Declare-Anweisungen, und markieren Sie sie mit dem PtrSafe-Attribut. leider sind meine Kenntnisse in VBA Bereich sehr beschränkt... denke aber es sind lediglich kleine Anpassungen vorzunehmen. Wäre schön wenn mir jemand helfen könnte. Die Office Hilfe bringt mir leider Garnichts ..... =) mfg Jonny