New record from code

• • Reply

  15 years ago

  by vandam

  Ian Brown

  England), United Kingdom

  Joined 15 years ago

  I have a database with a problem in the code, but I can't see the problem. Any help would be much appreciated.
  

  
  This is the code. Problem is when it runs through the MonthsYears section. I'm using this to print tasks, like the ones used in MS Outlook, for work. When running through the code it add's a new blank record at the end, this then messes up the DB.
  

  
  Sorry it's a bit long.
  

  
  

  
  '================================================= ================================================== ============
  Option Compare Database
  Option Explicit
  

  
  Dim o ' For testing purposes only
  Public i ' Loop count
  Public ThisCount ' Used for counting days
  Public MonYeaCount ' Used for counting Months Years
  Public verCurrentPD ' The day the report is printed
  Public verTmpPD ' The tempory Print Date
  Public tmpDays ' Tempory Number of days in a month
  Public verComb1 ' Tempory Month
  Public verComb2 ' Tempory 1st, 2nd, 3rd, ... ect
  Public verComb3 ' Tempory Day
  

  
  '================================================= ================================================== ============
  '
  Private Sub Form_Timer()
  'DoCmd.SetWarnings True
  Form.TimerInterval = 0
  Dim dbs As Database, rst As Recordset
  Set dbs = CurrentDb
  Set rst = dbs.OpenRecordset("Tasks")
  prgBar.Max = rst.recordCount
  Me!labProg.Format = "00"
  DoCmd.RunSQL "UPDATE Tasks SET Tasks.PrintDate = [tasks].[start]"
  For i = 1 To rst.recordCount
  If JobID = 189 Then
  Debug.Print JobID
  o = 1
  End If
  SetupVer ' -------------------------- This is the loop out
  DoCmd.GoToRecord , , acNext
  prgBar.Value = prgBar.Value + 1
  labProg = Format((prgBar.Value / prgBar.Max) * 100, "0") & " %"
  Next i
  DoCmd.GoToRecord , , acLast
  SetupVer ' -------------------------- This is the loop out
  rst.Close
  Set dbs = Nothing
  'Forms!Print!prgPrinOk = 1
  'DoCmd.Close
  End Sub
  

  
  

  
  '================================================= ================================================== ============
  '
  Private Sub SetupVer()
  verCurrentPD = (Forms!Print!txtPrintDate) ' Set verCurrentPD to the date from the form
  If TaskActive = 0 Then Exit Sub
  If IsNull(PrintDate.Value) Then PrintDate = Start
  If PrintDate >= verCurrentPD Then Exit Sub
  ThisCount = 0
  Select Case Recurrence
  Case 1
  Days
  Case 2
  Weeks
  Case 3, 4
  Select Case Combo2
  Case "first"
  verComb2 = 1
  Case "second"
  verComb2 = 2
  Case "third"
  verComb2 = 3
  Case "fourth"
  verComb2 = 4
  Case "last"
  verComb2 = 5
  End Select
  Select Case Combo3
  Case "day"
  verComb3 = 8
  Case "weekday"
  verComb3 = 9
  Case "weekend day"
  verComb3 = 10
  Case "Monday"
  verComb3 = 1
  Case "Tuesday"
  verComb3 = 2
  Case "Wednesday"
  verComb3 = 3
  Case "Thursday"
  verComb3 = 4
  Case "Friday"
  verComb3 = 5
  Case "Saturday"
  verComb3 = 6
  Case "Sunday"
  verComb3 = 7
  End Select
  If Recurrence = 3 Then Months
  If Recurrence = 4 Then Years
  End Select
  End Sub
  

  
  

  
  '================================================= ================================================== ============
  '
  Private Sub Days()
  Select Case Option1
  Case "1"
  Do While PrintDate < verCurrentPD ' If the PrintDate is less then the verCurrentPD
  PrintDate = DateAdd("d", Text1, PrintDate) ' then loop addinf the number of days
  If PrintDate >= verCurrentPD Then Exit Do ' If the PrintDate is the same as verCurrentPD then exit
  Loop
  Case "2"
  If WeekDay(verCurrentPD, vbMonday) < 6 Then PrintDate = verCurrentPD ' Set PrintDate to verCurrentPD
  If WeekDay(verCurrentPD, vbMonday) = 6 Then PrintDate = verCurrentPD + 2 ' Set PrintDate to Mon's date
  If WeekDay(verCurrentPD, vbMonday) = 6 Then PrintDate = verCurrentPD + 1 ' Set PrintDate to Mon's date
  End Select
  End Sub
  

  
  

  
  '================================================= ================================================== ============
  '
  Private Sub Weeks()
  Select Case WeekDay(Start, vbMonday)
  Case 1
  verTmpPD = Start
  Case 2
  verTmpPD = DateAdd("d", -1, Start)
  Case 3
  verTmpPD = DateAdd("d", -2, Start)
  Case 4
  verTmpPD = DateAdd("d", -3, Start)
  Case 5
  verTmpPD = DateAdd("d", -4, Start)
  Case 6
  verTmpPD = DateAdd("d", -5, Start)
  Case 7
  verTmpPD = DateAdd("d", -6, Start)
  End Select
  

  
  Select Case WeekDay(verCurrentPD, vbMonday)
  Case 1
  If Check1 = True Then WeeklyA
  Case 2
  verTmpPD = DateAdd("d", 1, verTmpPD)
  If Check2 = True Then WeeklyA
  Case 3
  verTmpPD = DateAdd("d", 2, verTmpPD)
  If Check3 = True Then WeeklyA
  Case 4
  verTmpPD = DateAdd("d", 3, verTmpPD)
  If Check4 = True Then WeeklyA
  Case 5
  verTmpPD = DateAdd("d", 4, verTmpPD)
  If Check5 = True Then WeeklyA
  Case 6
  verTmpPD = DateAdd("d", 5, verTmpPD)
  If Check6 = True Then WeeklyA
  Case 7
  verTmpPD = DateAdd("d", 6, verTmpPD)
  If Check7 = True Then WeeklyA
  End Select
  End Sub
  

  
  

  
  '================================================= ================================================== ============
  '
  Private Sub WeeklyA()
  Do While PrintDate < verCurrentPD
  verTmpPD = DateAdd("ww", Text1, verTmpPD)
  PrintDate = verTmpPD
  If PrintDate >= verCurrentPD Then Exit Do
  Loop
  End Sub
  

  
  

  
  '================================================= ================================================== ============
  '
  Private Sub Months()
  MonYeaCount = 0
  Select Case Option1
  Case 1
  PrintDate = DateValue(Text1 & " " & (Month(PrintDate)) & " " & (Year(PrintDate)))
  Do While PrintDate < verCurrentPD
  PrintDate = DateAdd("m", Text2, PrintDate)
  If PrintDate >= verCurrentPD Then Exit Do
  Loop
  Case 2
  verTmpPD = DateValue("1" & " " & (Month(PrintDate)) & " " & (Year(PrintDate)))
  Do While verTmpPD < verCurrentPD
  verTmpPD = DateAdd("m", Text2, verTmpPD)
  Loop
  MonthsYears
  End Select
  End Sub
  

  
  

  
  '================================================= ================================================== ============
  '
  Private Sub Years()
  MonYeaCount = 0
  Select Case Option1
  Case 1
  PrintDate = DateValue(Text1 & " " & Combo1 & " " & (Year(PrintDate)))
  Do While PrintDate < verCurrentPD
  PrintDate = DateAdd("yyyy", 1, PrintDate)
  If PrintDate >= verCurrentPD Then Exit Do
  Loop
  Case 2
  verTmpPD = DateValue("1" & " " & Combo1 & " " & (Year(PrintDate)))
  Do While verTmpPD < verCurrentPD
  verTmpPD = DateAdd("yyyy", 1, verTmpPD)
  Loop
  MonthsYears
  End Select
  End Sub
  

  
  

  
  '================================================= ================================================== ============
  '
  Private Sub MonthsYears()
  ThisCount = 0
  Select Case Month(verTmpPD)
  Case 1, 3, 5, 7, 8, 10, 12 ' 31 days - Jan, Mar, May, Jul, Aug, Oct, Dec
  tmpDays = 31
  Case 4, 6, 9, 11 ' 30 days - Apr, Jun, Sep, Nov
  tmpDays = 30
  Case 2 ' Feb
  If IsLeapYear("01/01" & Year(verTmpPD)) Then
  tmpDays = 29
  Else
  tmpDays = 28
  End If
  End Select
  Do While PrintDate < verCurrentPD
  PrintDate = verTmpPD
  MonYeaCount = MonYeaCount + 1
  If MonYeaCount > 1 Then
  PrintDate = verTmpPD
  If Recurrence = 3 Then Months
  If Recurrence = 4 Then Years
  End If
  Select Case verComb3
  Case 1 To 7 ' Monday to Sunday
  Select Case verComb2
  Case 1, 2, 3, 4
  For i = 1 To tmpDays
  If WeekDay(i & "/" & Month(PrintDate) & "/" & Year(PrintDate), vbMonday) = verComb3 Then
  verTmpPD = i & "/" & Month(PrintDate) & "/" & Year(PrintDate)
  ThisCount = ThisCount + 1
  If ThisCount = verComb2 Then
  PrintDate = verTmpPD
  Exit For
  End If
  End If
  Next i
  Case 5
  For i = 1 To tmpDays
  If WeekDay(i & "/" & Month(PrintDate) & "/" & Year(PrintDate), vbMonday) = verComb3 Then
  PrintDate = i & "/" & Month(PrintDate) & "/" & Year(PrintDate)
  End If
  Next i
  End Select
  Case 8 ' Day
  Select Case verComb2
  Case 1, 2, 3, 4
  PrintDate = verComb2 & "/" & Month(PrintDate) & "/" & Year(PrintDate)
  Case 5
  PrintDate = tmpDays & "/" & Month(PrintDate) & "/" & Year(PrintDate)
  End Select
  Case 9 ' Weekday
  Select Case verComb2
  Case 1, 2, 3, 4
  ThisCount = 0
  For i = 1 To tmpDays
  If WeekDay(i & "/" & Month(PrintDate) & "/" & Year(PrintDate), vbMonday) < 6 Then
  'If WeekDay(i & "/" & Month(PrintDate) & "/" & Year(PrintDate), vbMonday) <> 6 And _
  ' WeekDay(i & "/" & Month(PrintDate) & "/" & Year(PrintDate), vbMonday) <> 7 Then
  PrintDate = i & "/" & Month(PrintDate) & "/" & Year(PrintDate)
  ThisCount = ThisCount + 1
  If ThisCount = verComb2 Then Exit For
  End If
  Next i
  Case 5
  For i = 1 To tmpDays
  If WeekDay(i & "/" & Month(PrintDate) & "/" & Year(PrintDate), vbMonday) < 6 Then
  'If WeekDay(i & "/" & Month(PrintDate) & "/" & Year(PrintDate), vbMonday) <> 6 And _
  ' WeekDay(i & "/" & Month(PrintDate) & "/" & Year(PrintDate), vbMonday) <> 7 Then
  PrintDate = i & "/" & Month(PrintDate) & "/" & Year(PrintDate)
  End If
  Next i
  End Select
  Case 10 ' Weekend
  Select Case verComb2
  Case 1, 2, 3, 4
  For i = 1 To tmpDays
  If WeekDay(i & "/" & Month(PrintDate) & "/" & Year(PrintDate), vbMonday) > 5 Then
  PrintDate = i & "/" & Month(PrintDate) & "/" & Year(PrintDate)
  ThisCount = ThisCount + 1
  If ThisCount = verComb2 Then Exit For
  End If
  Next i
  Case 5
  For i = 1 To tmpDays
  If WeekDay(i & "/" & Month(PrintDate) & "/" & Year(PrintDate), vbMonday) > 5 Then
  PrintDate = i & "/" & Month(PrintDate) & "/" & Year(PrintDate)
  End If
  Next i
  End Select
  End Select
  Loop
  End Sub
  

  
  

  
  '================================================= ================================================== ============
  '
  ' This is the Yearly forcast
  '
  Function IsLeapYear(ByVal SomeValue As Variant) As Boolean
  On Error GoTo LocalError
  Dim intYear As Integer
  'The trick here is make sure that we get an integer.
  'The 3 Golden rules are:
  ' True if it is divisible by 4
  ' False if it is divisible by 100
  ' TRUE if it is divisble by 400
  If IsDate(SomeValue) Then
  intYear = CInt(Year(SomeValue))
  Else
  'Try and get an integer from the parse does not matter if we get an error because
  'the error trap will catch it
  intYear = CInt(SomeValue)
  End If
  

  
  If TypeName(intYear) = "Integer" Then
  IsLeapYear = ((intYear Mod 4 = 0) And _
  (intYear Mod 100 <> 0) Or (intYear Mod 400 = 0))
  End If
  

  
  Exit Function
  LocalError:
  IsLeapYear = False
  

  
  End Function

  Report abuse