Add the Lunar Calendar support module in Access

Create a new module and copy the following two functions. GLGETNL (), STRNL ()

Using in Queries: Select Glgetnl (born) as Nlborn from Empolyee where GLGETNL (born) > "05012" Order by Glgetnl (born)

The above query returns a list of more than May 12 employees for the lunar calendar, sorted by lunar birthday.

(Disclaimer: These two functions are not written from scratch, are modified on the Internet do not know whose program code came.)
To Google enter the keyword VB lunar calendar can find a number of references to this article

Originally intended to be called directly in ASP, it was later put into the database, but it can be used in Access, and ADO cannot be invoked in ASP. The 1998 lunar Leap Month in the original data was found in the debugging and not the Semi-rotary in the original code, and the Ganzhi algorithm was modified. Also did not go to contact with the original author, forgive me .)

' Enter date, return ' mmlddyyyy ' mm: month; L:1, Leap month, 0, ordinary months; DD: day; YYYY year
Function glgetnl (ByVal gldate)

Dim Dalist (111)
' 1900 to 1909
Dalist (0) = "010010110110180131"
Dalist (1) = "010010101110000219"
Dalist (2) = "101001010111000208"
Dalist (3) = "010100100110150129"
Dalist (4) = "110100100110000216"
Dalist (5) = "110110010101000204"
Dalist (6) = "011010101010140125"
Dalist (7) = "010101101010000213"
Dalist (8) = "100110101101000202"
Dalist (9) = "010010101110120122"
Dalist (10) = "010010101110000210"
Dalist (11) = "101001001101160130"
Dalist (12) = "101001001101000218"
Dalist (13) = "110100100101000206"
Dalist (14) = "110101010100150126"
Dalist (15) = "101101010101000214"
Dalist (16) = "010101101010000204"
Dalist (17) = "100101101101020123"
Dalist (18) = "100101011011000211"
Dalist (19) = "010010011011170201"
Dalist (20) = "010010011011000220"
Dalist (21) = "101001001011000208"
Dalist (22) = "101100100101150128"
Dalist (23) = "011010100101000216"
Dalist (24) = "011011010100000205"
Dalist (25) = "101011011010140124"
Dalist (26) = "001010110110000213"
Dalist (27) = "100101010111000202"
Dalist (28) = "010010010111120123"
Dalist (29) = "010010010111000210"
Dalist (30) = "011001001011060130"
Dalist (31) = "110101001010000217"
Dalist (32) = "111010100101000206"
Dalist (33) = "011011010100150126"
Dalist (34) = "010110101101000214"
Dalist (35) = "001010110110000204"
Dalist (36) = "100100110111030124"
Dalist (37) = "100100101110000211"
Dalist (38) = "110010010110170131"
Dalist (39) = "110010010101000219"
Dalist (40) = "110101001010000208"
Dalist (41) = "110110100101060127"
Dalist (42) = "101101010101000215"
Dalist (43) = "010101101010000205"
Dalist (44) = "101010101101140125"
Dalist (45) = "001001011101000213"
Dalist (46) = "100100101101000202"
Dalist (47) = "110010010101120122"
Dalist (48) = "101010010101000210"
Dalist (49) = "101101001010170129"
Dalist (50) = "011011001010000217"
Dalist (51) = "101101010101000206"
Dalist (52) = "010101011010150127"
Dalist (53) = "010011011010000214"
Dalist (54) = "101001011011000203"
Dalist (55) = "010100101011130124"
Dalist (56) = "010100101011000212"
Dalist (57) = "101010010101080131"
Dalist (58) = "111010010101000218"
Dalist (59) = "011010101010000208"
Dalist (60) = "101011010101060128"
Dalist (61) = "101010110101000215"
Dalist (62) = "010010110110000205"
Dalist (63) = "101001010111040125"
Dalist (64) = "101001010111000213"
Dalist (65) = "010100100110000202"
Dalist (66) = "111010010011030121"
Dalist (67) = "110110010101000209"
Dalist (68) = "010110101010170130"
Dalist (69) = "010101101010000217"
Dalist (70) = "100101101101000206"
Dalist (71) = "010010101110150127"
Dalist (72) = "010010101101000215"
Dalist (73) = "101001001101000203"
Dalist (74) = "110100100110140123"
Dalist (75) = "110100100101000211"
Dalist (76) = "110101010010180131"
Dalist (77) = "101101010100000218"
Dalist (78) = "101101101010000207"
Dalist (79) = "100101101101060128"
Dalist (80) = "100101011011000216"
Dalist (81) = "010010011011000205"
Dalist (82) = "101001001011140125"
Dalist (83) = "101001001011000213"
Dalist (+) = "1011001001011a0202"
Dalist (85) = "011010100101000220"
Dalist (86) = "011011010100000209"
Dalist (87) = "101011011010060129"
Dalist (88) = "101010110110000217"
Dalist (89) = "100100110111000206"
Dalist (90) = "010010010111150127"
Dalist (91) = "010010010111000215"
Dalist (92) = "011001001011000204"
Dalist (93) = "011010100101030123"
Dalist (94) = "111010100101000210"
Dalist (95) = "011010110010180131"
Dalist (96) = "010110101100000219"
Dalist (97) = "101010110110000207"
Dalist (98) = "100100110110050128"
Dalist (99) = "100100101110000216"
Dalist (100) = "110010010110000205"
Dalist (101) = "110101001010140124"
Dalist (102) = "110101001010000212"
Dalist (103) = "110110100101000201"
Dalist (104) = "010110101010120122"
Dalist (105) = "010101101010000209"
Dalist (106) = "101010101101170129"
Dalist (107) = "001001011101000218"
Dalist (108) = "100100101101000207"
Dalist (109) = "110010010101150126"
Dalist (110) = "101010010101000214"
Dalist (111) = "101101001010000214"

On Error Resume Next
Dim Condate as Date
Dim tyear, Addmonth, Addday, Addyear, Getday, I as Integer
Dim Runyue as Boolean

Tyear = year (gldate)

If tyear > Or tyear < 1901 Then
GLGETNL = ""
Exit Function ' Exits if it is not a valid date
End If

Runyue = False
Addyear = Tyear

Todo
Addmonth = CInt (Mid (Dalist (AddYear-1900), 15, 2))
Addday = CInt (Mid (Dalist (AddYear-1900), 17, 2))
Condate = DateSerial (Addyear, Addmonth, Addday)
Getday = DateDiff ("D", Condate, Gldate)
If getday < 0 Then addyear = AddYear-1
Loop while Getday < 0

Addday = 1
Addmonth = 1
For i = 1 to Getday
Addday = Addday + 1
If Addday = + CInt (Mid (Dalist (AddYear-1900), Addmonth, 1)) Or (Runyue and addday = + CInt (Mid dalist (AddYear-190 0), Then, 1))
If Runyue = False and Addmonth = CInt ("&h" & Mid (Dalist (AddYear-1900), 1)) Then
Runyue = True
Else
Runyue = False
Addmonth = addmonth + 1
End If
Addday = 1
End If

Next

GLGETNL = IIF (Addmonth > 9, CStr (addmonth), "0" + CStr (addmonth)) + IIF (Runyue, "1", "0") + IIF (Addday > 9, CStr (ADD Day), "0" + CStr (addday) + CStr (addyear)
End Function

' Input snl= ' mmlddyyyy ' mm: month; L:1, Leap month, 0, ordinary months; DD: day; YYYY year
The function returns "XX month XX", the sign of the Zodiac deposit Sshuxinag, Ganzhi in the year Syear

Function STRNL (ByVal sNl, ByRef Sshuxiang, ByRef syear)

Dim LNL_MD, lnl_cm, Lnl_tiangan, Lnl_dizhi, Lnl_shu
LNL_MD = "First grade Hansi Duanwu arrest When初七because Day 1.,234,567,892,212,22e,+28"
lnl_cm = "234,567,890 Cold wax"
Lnl_tiangan = "B-Butyl Xing"
Lnl_dizhi = "Kaniko Chen has not Shin in the afternoon"
Lnl_shu = "Rat ox tiger rabbit snake horse sheep monkey chicken Dog Pig"

On Error Resume Next
Dim iy, IM, ID, isleap
im = CInt (Left (sNl, 2))
Isleap = CInt (Mid (SNl, 3, 1))
id = CInt (Mid (SNl, 4, 2))
iy = CInt (Right (sNl, 4))
STRNL = Mid (lnl_cm, IM, 1) & "Month" & Mid (LNL_MD, (id-1) * 2 + 1, 2)
If isleap > 0 Then strnl = "Leap" & STRNL
iy = iy-4
Sshuxiang = Mid (Lnl_shu, (iy Mod 12) + 1, 1)
Syear = Mid (Lnl_tiangan, (iy MoD) + 1, 1) & Mid (Lnl_dizhi, (iy mod 12) + 1, 1)
End Function