-
Notifications
You must be signed in to change notification settings - Fork 1
/
Date9597.bas
78 lines (69 loc) · 1.87 KB
/
Date9597.bas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
Attribute VB_Name = "Date9597"
Option Explicit
'
' Date9597
' Version 1.0.0
'
' (c) Gustav Brock, Cactus Data ApS, CPH
' https://github.com/GustavBrock/VBA.Date
'
' Functions to replace the native VBA.DateTime functions in
' Access 95 and 97.
'
' License: MIT (http://opensource.org/licenses/mit-license.php)
'
' Required references:
' None
'
' Required modules:
' DateBase
' DateCalc
' DateCore
' DateFind
' DateMsec
'
' Direct replacement for DateAdd for Access 95/97 only.
'
' In Access 95/97, DateAdd() is buggy as it will return invalid
' date values between the numeric data values -1 and 0.
' With Access 2000 and newer, DateAdd() can be used as is.
'
' 2006-02-15. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function DateAdd9x( _
ByVal Interval As String, _
ByVal Number As Double, _
ByVal Date1 As Date) _
As Date
' Version major of Access 97.
Const VersionMajorMax As Byte = 8
' Store current version of Access.
Static VersionMajor As Byte
Dim Result As Date
Dim Factor As Long
Dim Milliseconds As Double
If VersionMajor = 0 Then
' Read and store the current version of Access.
VersionMajor = Val(SysCmd(acSysCmdAccessVer))
End If
If VersionMajor > VersionMajorMax Then
' Use DateAdd() as is.
Result = DateAdd(Interval, Number, Date1)
Else
Select Case Interval
Case "h"
Factor = HoursPerDay
Case "n"
Factor = MinutesPerDay
Case "s"
Factor = SecondsPerDay
End Select
If Factor > 0 Then
Milliseconds = MillisecondsPerDay * Number / Factor
Result = MsecSerial(Milliseconds, Date1)
Else
Result = DateAdd(Interval, Number, Date1)
End If
End If
DateAdd9x = Result
End Function