在access中增加农历支持模块

ddDay = 1
AddMonth = 1
For i = 1 To getDay
AddDay = AddDay + 1
If AddDay = 30 + CInt(Mid(daList(AddYear - 1900), AddMonth, 1)) Or (RunYue And AddDay = 30 + CInt(Mid(daList(AddYear - 1900), 13, 1))) Then
If RunYue = False And AddMonth = CInt("&H" & Mid(daList(AddYear - 1900), 14, 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(AddDay), "0" + CStr(AddDay)) + CStr(AddYear)
End Function

' 输入sNl="mmlddyyyy" mm: 月份; l: 1,闰月,0,平常月; dd: 日; yyyy年份
' 函数返回"XX月XX", 属相存入sShuXinag, 干支记年存入sYear

Function strnl(ByVal sNl, ByRef sShuXiang, ByRef sYear)

Dim lnl_md, lnl_cm, lnl_tiangan, lnl_dizhi, lnl_shu
lnl_md = "初一初二初三初四初五初六初七初八初九初十十一十二十三十四十五十六十七十八十九二十廿一廿二廿三廿四廿五廿六廿七廿八廿九三十"
lnl_cm = "正二三四五六七八九十寒腊"
lnl_tiangan = "甲乙丙丁戊已庚辛壬癸"
lnl_dizhi = "子丑寅卯辰巳午未申酉戌亥"
lnl_shu = "鼠牛虎兔龙蛇马羊猴鸡狗猪"

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) & "月" & Mid(lnl_md, (id - 1) * 2 + 1, 2)
If isLeap > 0 Then strnl = "闰" & strnl
iy = iy - 4
sShuXiang = Mid(lnl_shu, (iy Mod 12) + 1, 1)
sYear = Mid(lnl_tiangan, (iy Mod 10) + 1, 1) & Mid(lnl_dizhi, (iy Mod 12) + 1, 1)
End Function