查询遗漏的日期

123shusheng

经过摸索，应该是这样的，我明白了。谢谢论坛里的各位老大的指点！
Private Sub 年度_AfterUpdate()
    If IsNull(Me.年度.Value) = False And IsNull(Me.月度.Value) = False Then
        Me.遗漏日期.RowSource = GetDateList(Me.年度.Value, Me.月度.Value, "数据表", "日期")
    End If
End Sub

Private Sub 月度_AfterUpdate()
    If IsNull(Me.年度.Value) = False And IsNull(Me.月度.Value) = False Then
        Me.遗漏日期.RowSource = GetDateList(Me.年度.Value, Me.月度.Value, "数据表", "日期")
    End If
End Sub

Function GetDateList(ByVal y As Long, ByVal m As Long, ByVal tbname As String, DateFildname As String) As String


    Dim str As String
    Dim ssql As String
    Dim i As Long
    Dim d0 As Date
    Dim d1 As Date
   
    ssql = "select * from " & tbname & " where year(" & DateFildname & ")=" & y & " and month(" & DateFildname & ")=" & m

    Me.数据表.RowSource = ssql

   
    If Year(Date) = y And Month(Date) = m Then
        d1 = Date
    Else
        d1 = DateSerial(y, m + 1, 0)
    End If
   
    str = ""
    d0 = DateSerial(y, m, 1)
    Do While d0 <= d1
        If DCount("*", "" & tbname & "", "日期=#" & d0 & "#") = 0 Then
            str = str & d0 & ";"
        End If
        d0 = DateAdd("d", 1, d0)
    Loop
    str = Left(str, Len(str) - 1)
    GetDateList = str
End Function

123shusheng

经过一段时间的使用，的确可以检查遗漏的日期，但存在一个问题，如果没有遗漏的日期，就会出现提示框，提示运行错误需要调试，能否不不出现提示框，遗漏日期列表框中显示空白就行了，请高手指点，谢谢！

123shusheng

str = Left(str, Len(str) - 0)
我知道了，要修改这一句，