by Ravi & SASI (1 Submission)
Category: OLE/COM/DCOM/Active-X
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Fri 14th December 2001
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
A full-fledged user-friendly and interactive calender program.
API Declarations
Dim rs As New ADODB.Recordset, rs1 As New ADODB.Recordset
Dim rs4 As New ADODB.Recordset
Dim r As New ADODB.Recordset
Dim r1 As New ADODB.Recordset
Dim r2 As New ADODB.Recordset, r3 As New ADODB.Recordset
Dim inday As String, sday As String, eday As String
VBcoders
Unload Me
End Sub
Private Sub Form_Load()
Set cn = New ADODB.Connection
cn.Open "FileDSN=cid"
End Sub
Private Sub genrepcmb_Click()
inday = Format(Calendar1.Value, "dddd")
Select Case inday
Case "Sunday"
sday = Calendar1.Value + 0
eday = Calendar1.Value + 6
Case "Monday"
sday = Calendar1.Value - 1
eday = Calendar1.Value + 5
Case "Tuesday"
sday = Calendar1.Value - 2
eday = Calendar1.Value + 4
Case "Wednesday"
sday = Calendar1.Value - 3
eday = Calendar1.Value + 3
Case "Thursday"
sday = Calendar1.Value - 4
eday = Calendar1.Value + 2
Case "Friday"
sday = Calendar1.Value - 5
eday = Calendar1.Value + 1
Case "Saturday"
sday = Calendar1.Value - 6
eday = Calendar1.Value + 0
End Select
MsgBox sday & " " & eday
Set rs = New ADODB.Recordset
rs.CursorLocation = adUseClient
rs.Open "select * from Seizure_Master where Doo >= ( cdate(' " & Format(sday, "dd/mm/yy") & "') and Doo <= cdate(' " & Format(eday, "dd/mm/yy") & "') )", cn, adOpenForwardOnly, adLockReadOnly
Set rs1 = New ADODB.Recordset
rs1.CursorLocation = adUseClient
rs1.Open "select * from Seizure_Comm where Doo >= ( cdate(' " & Format(sday, "dd/mm/yy") & "') and Doo <= cdate(' " & Format(eday, "dd/mm/yy") & "') )", cn, adOpenForwardOnly, adLockReadOnly
'Set rs = New ADODB.Recordset
'rs.CursorLocation = adUseClient
'rs.Open "select * from Seizure_Master where Doo >= ( cdate(' " & Format(sday, "dd/mm/yy") & "') and Doo <= cdate(' " & Format(eday, "dd/mm/yy") & "') )", cn, adOpenForwardOnly, adLockReadOnly
If Not rs.EOF Then
Set r = Nothing
r.Open "select * from repw", cn, adOpenDynamic, adLockOptimistic
Do While Not r.EOF
r.Delete
r.MoveNext
Loop
udoo = Calendar1.Value
If rs.RecordCount > rs1.RecordCount Then
cnt = rs.RecordCount
Else
cnt = rs1.RecordCount
End If
For i = 1 To cnt
Set r = Nothing
r.Open "select * from Unit where Unit_Code=" & rs("Unit_Code") & "", cn, adOpenForwardOnly, adLockReadOnly
If Not r.EOF Then ouname = r("cscid_unit")
Set r = Nothing
r.Open "select * from Offence_Type where Off_Code=" & rs("off_Code") & "", cn, adOpenForwardOnly, adLockReadOnly
If Not r.EOF Then ooname = r("off_Name")
Set rs4 = New ADODB.Recordset
Set rs4 = Nothing
rs4.Open "select * from repw", cn, adOpenDynamic, adLockOptimistic
If rs4.EOF Or Not rs4.EOF Then
rs4.AddNew
rs4(0) = ouname
rs4(1) = ooname
rs4(2) = ocname
rs4(3) = qq
'rs("off_Code") 'ooname ' & "-" & r2.RecordCount
rs4.Update
End If
If Not rs.EOF Then rs.MoveNext
Next
End If
MsgBox "end"
CrystalReport1.Action = 1
CrystalReport1.ReportFileName = "c:\cid\weekrep.rpt"
End Sub
