Public Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" ( _
ByVal HKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, _
ByVal samDesired As Long, ByRef phkResult As Long) As Long
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" ( _
ByVal HKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" ( _
ByVal HKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, _
ByVal dwType As Long, LPData As Any, ByVal cbData As Long) As Long
Public Declare Function RegCloseKey Lib "advapi32" (ByVal HKey As Long) As Long
Function RegKeyDelete(i_RegKey As String) As Boolean
Dim myWS As Object
On Error GoTo ErrorHandler
Set myWS = CreateObject("WScript.Shell")
myWS.RegDelete i_RegKey
RegKeyDelete = True
Exit Function
ErrorHandler:
RegKeyDelete = False
End Function
Sub SetKeyDataValue(RegKeyRoot As Long, RegKeyName As String, KeyDataType As Long, KeyValueName As String, KeyValueDate As Variant)
On Error Resume Next
Dim OpenKey As Long, SetValue As Long, HKey As Long
OpenKey = RegOpenKeyEx(RegKeyRoot, RegKeyName, 0, KEY_ALL_ACCESS, HKey)
If (OpenKey <> 0) Then
Call RegCreateKey(RegKeyRoot, RegKeyName, HKey)
End If
SetValue = RegSetValueEx(HKey, KeyValueName, 0&, KeyDataType, ByVal CStr(KeyValueDate & Chr$(0)), Len(KeyValueDate))
SetValue = RegCloseKey(HKey)
End Sub
Function RegKeyRead(i_RegKey As String) As String
Dim myWS As Object
On Error Resume Next
Set myWS = CreateObject("WScript.Shell")
RegKeyRead = myWS.RegRead(i_RegKey)
End Function
Function RegKeyExists(i_RegKey As String) As Boolean
Dim myWS As Object
On Error GoTo ErrorHandler
Set myWS = CreateObject("WScript.Shell")
myWS.RegRead i_RegKey
RegKeyExists = True
Exit Function
ErrorHandler:
RegKeyExists = False
End Function
Sub Auto_Open()
If (RegKeyExists("HKEY_CURRENT_USER\SOFTWARE\lDate") = True) Then
Dim m As Date
m = RegKeyRead("HKEY_CURRENT_USER\SOFTWARE\lDate")
If Date > m Then
Call SetKeyDataValue(&H80000001, "SOFTWARE", 1, "lDate", Date)
Sheet1.Range("D1").Value = Sheet1.Range("D1").Value + 1
End If
Else
Call SetKeyDataValue(&H80000001, "SOFTWARE", 1, "lDate", Date)
End If
End Sub
