Auto-Generate new records per month

[gottnoskill]

I have a daily inventory and inspection sheet that needs to be signed by employees to make sure all things are in order before the day starts. The previous method of doing this for whatever reason was about 40 different excel files in many different folders. So I'm attempting to make this method easier by creating one access database file that would have all this information. I've set up all tables accordingly and I have a pretty good idea what I need to do to make all this work except this one problem.



I would have the user view a table form of the current month. Each record in the table would be a unique day of that month and all they need to do is place initials and pass/fail and fill out the record for that day.

I would like my table form to generate new records each month when the month starts. Each new record would have a date for the table up until the last date of the month and stop.

I have tried to look up solutions to this and haven't really found a good direction to go in yet. I could manually place all dates, but that would take an annoying amount of maintenance every month.

[RuralGuy]

Are you prepared to do it with VBA?

[gottnoskill]

Yeah. The only thing im not comfortable with is queries, but I'm sure I could do it if I messed with it. I'm more comfortable with VBA.

[RuralGuy]

Can you create the procedure that can add the records to the table? Day 0 of the next month will tell you how many days there are in that month.

[RuralGuy]

I would be glad to assist but would need some more details about the table to give anything specific.

[gottnoskill]

The table itself has these columns and their are multiple unit tables with the same columns

Table Name: tbl_aS_A1UnitInspection

UINSP-ID (Auto Number)
InspectionDate (Date)
PassFail (Lookup & Relationship) 'From tbl_PassFail Values of 'Pass' 'Fail'
EmployeeIN (Text) 'Employee Initials
SupervisorIN (Text) 'Supervisor Initials
Comments (Text) 'Explenation of Failed Inspection
Shift (Lookup & Relationship) 'From tbl_Shift Values of 'A' 'B' 'C'

I'm really just lost on how the VBA would look or how I would repeat to add a new record until the end of the month.

I was thinking (and correct me if I'm wrong) If statements are needed to see if the current month & current year = a dlookup of the InspectionDate current month & year.

If its true then nothing happens if not then the else would be adding a new record for the date and +1 loop it until the end of the month.

I would place the event on the load form where the table would be displayed.

I really have no clue how I would write that or what type of arguments I would need. With my limited knowledge this is what I've come up with so far

Dim db As Database
Dim rst As DAO.Recordset

FirstDay = DateSerial(Year(date), Month(date), 1)
LastDay = DateSerial(Year(date), Month(date) + 1, 0)

Set db = CurrentDb
Set rst = db.OpenRecordset("tbl_aS_A1UnitInspection")
rst("InspectionDate").Value = FirstDay
rst.Update

I just got into work so I'm going to try and figure this out as the day goes on and will post if I find anything significant.

[RuralGuy]

Would it be ok to leave all but the InspectionDate field empty when adding the records? The AutoNumber field will take care of itself.

[gottnoskill]

Dim VarDate As Date
Dim enddate As Date
FirstDay = DateSerial(Year(Date), Month(Date), 0)
lastDay = DateSerial(Year(Date), Month(Date) + 1, 0)

VarDate = FirstDay
enddate = lastDay

Dim db As Database
Dim rs As DAO.Recordset

Set db = CurrentDb
Set rs = db.OpenRecordset("tbl_aS_A1UnitInspection")

Do While VarDate < enddate

VarDate = DateAdd("D", 1, VarDate)

rs.AddNew
rs("InspectionDate").Value = VarDate
rs("Shift").Value = "1"
rs.Update

Loop

I feel really dumb. This is the second time I've posted for help and soon figured out the solution to something that's been nagging me for days.

Yeah everything was going to be blank on the exception of InspectionDate and Shift so that the employee and supervisor can sign off on them. The table would just be displaying the records so they may add information to them.

Although that problem is solved I need to figure out how to create an if function that will keep this code from running if we already have added the dates for that month.

[RuralGuy]

Your code will look something like (*UNTESTED*):

Public Sub NewMonth(ThisDay As Date)
   On Error GoTo Err_NewMonth
   ' Create a record for each day of the incoming date.
   Dim MyRS As DAO.Recordset
   Dim MyRecordCount As Integer
   Dim WorkingDate As Date
   Set MyRS = CurrentDb().OpenRecordset("tbl_aS_A1UnitInspection", dbOpenDynaset)
   WorkingDate = DateSerial(Year(ThisDay), month(ThisDay), 1)
   With MyRS
      For MyRecordCount = 1 To Day(DateSerial(Year(ThisDay), month(ThisDay) + 1, 0))
         .AddNew
         MyRS!InspectionDate = WorkingDate
         MyRS.Update
         WorkingDate = WorkingDate + 1
      Next
   End With
Exit_NewMonth:
   If Not MyRS Is Nothing Then
      MyRS.Close
      Set MyRS = Nothing
   End If
   Exit Sub
Err_NewMonth:
   MsgBox Err & ": " & vbCrLf & Err.Description
   Resume Exit_NewMonth
End Sub

...then all you need do is test if your *ThisDay* exists and if not then pass that date to this procedure.

[gottnoskill]

I had to add

Thisday = Date

to the procedure to get the right dates. For some reason just running it as is gives me dates from 1899 and a 12:00:00AM entry aswell. I thought that was odd behavior.

Anyways I created an If statement with a Dlookup. For some reason Just adding 'Date' to the criteria returns a null value. So I placed

If Date = DLookup("InspectionDate", _
"tbl_aS_A1UnitInspection", _
"Year([InspectionDate]) = " & Year(Date) & _
" And Month([InspectionDate]) = " & Month(Date) & _
" And Day([InspectionDate]) = " & Day(Date)) Then

Else

NewMonth (ThisDay)

End If

Without underscores

If Date = DLookup("InspectionDate", "tbl_aS_A1UnitInspection", "Year([InspectionDate]) = " & Year(Date) & " And Month([InspectionDate]) = " & Month(Date) & " And Day([InspectionDate]) = " & Day(Date)) Then

Else

NewMonth (ThisDay)

End If

I appreciate the help! You're great RuralGuy.

[RuralGuy]

You should be careful because DATE is a reserved word: http://www.allenbrowne.com/AppIssueBadWord.html#D