Results 1 to 5 of 5
  1. #1
    Join Date
    Sep 2003
    Location
    MN US
    Posts
    313

    Unanswered: Add multiple records

    Hello,
    I'm looking for thoughts on how I can accomplish this.
    I have a database that tracks appointments with clients.
    My fields look like this

    SchedTransID
    keyClientID
    keyEmpID
    StartofCare (Date)
    Mon (Y/N)
    Tues (Y/N)...
    Sun (Y/N)
    StartTime
    EndTime

    I need a function that will allow me to input a number of occurences, then add that many records to the table. The date needs to be incremented by 7 days for each new record.
    I have about 400 clients to track and this would greatly reduce data-entry (their weekly schedules rarely change).
    I'm an amateur programmer, so I'm afraid of getting off on the wrong foot and making a mess.

    Thanks in advance for any ideas.

  2. #2
    Join Date
    Jan 2004
    Posts
    184

    Re: Add multiple records

    Make a function that adds one record and then make a loop that calls that function. Is that what you want?
    In abundance of water only the fool is thirsty. Bob Marley.

  3. #3
    Join Date
    Feb 2004
    Location
    AZ
    Posts
    12

    Re: Add multiple records

    I'll take a stab at this...Not 100% sure what you're asking for, but hopefully this is enough to get things started for you.

    Assumptions:
    1. SchedTransID is an AutoNumber, if not you'll have to add it to parameters
    2. The field StartOfCare is when the first appointment is, then you want to create n records with an increment of 7 days. (So if I pass in 1/1/01 as the start date, and pass in 2 as the pintNumberOfOccurances then 2 records would be created 1/1/01 and 1/7/01--if I have my loop right)

    Anyways, try this code:

    Code:
    Public Sub AddDaysToSomeAppt(ByVal plngkeyClientID As Long, _
                                ByVal plngkeyEmpID As Long, _
                                ByVal pdatStartOfCare As Date, _
                                ByVal pfMon As Boolean, _
                                ByVal pfTues As Boolean, _
                                ByVal pfSun As Boolean, _
                                ByVal pintNumberOfOccurances as Integer, _   'Number of times you want record added
                                ByVal pdatStartTime as Date, _
                                ByVal pdatEndTime as Date)
    
    On Error GoTo ErrorHandler
        Dim cnnCurrent As New ADODB.Connection
        Dim rstCurrent As New ADODB.Recordset
        Dim strSQL As String
        Dim intCounter as Integer
        Dim datCurrentDate as Date
    'Init
        Set cnnCurrent = CurrentProject.Connection
        strSQL = "SELECT keyClientID, keyEmpID, ,StartofCare, Mon, Tues, Sun, StartTime, EndTime " & _
                 "FROM YOUR_TABLE_NAME;"
        rstCurrent.Open strSQL, cnnCurrent, adOpenKeyset, adLockOptimistic
        datCurrentDate = pdatStartDate
        intCounter = 1
        datCurrentDate = pdatStartOfCare
        Do Until pintNumberOfOccurances> intCounter
                 With rstCurrent
                    .AddNew
                        !keyClientID = plngkeyClientID
                        !keyEmpID = plngkeyEmpID
                        !StartofCare = datCurrentDate
                        !Mon = pfMon
                        !Tues = pfTues
                        !Sun = pfSun
                        !StartTime = pdatStartTime
                        !EndTime = pdatEndTime
                    .Update
                End With
            End If
            intCounter = intCounter + 1
            datCurrentDate = datCurrentDate + 7
        Loop
    Exit Sub
    ErrorHandler:
            Case Else
                MsgBox Err.Number & Chr(10) & Chr(10) & Err.Description
                Resume Next
        End Select
    End Sub

  4. #4
    Join Date
    Sep 2003
    Location
    MN US
    Posts
    313

    Re: Add multiple records

    Originally posted by jthammond
    I'll take a stab at this...Not 100% sure what you're asking for, but hopefully this is enough to get things started for you.

    Assumptions:
    1. SchedTransID is an AutoNumber, if not you'll have to add it to parameters
    2. The field StartOfCare is when the first appointment is, then you want to create n records with an increment of 7 days. (So if I pass in 1/1/01 as the start date, and pass in 2 as the pintNumberOfOccurances then 2 records would be created 1/1/01 and 1/7/01--if I have my loop right)

    Anyways, try this code:

    Code:
    Public Sub AddDaysToSomeAppt(ByVal plngkeyClientID As Long, _
                                ByVal plngkeyEmpID As Long, _
                                ByVal pdatStartOfCare As Date, _
                                ByVal pfMon As Boolean, _
                                ByVal pfTues As Boolean, _
                                ByVal pfSun As Boolean, _
                                ByVal pintNumberOfOccurances as Integer, _   'Number of times you want record added
                                ByVal pdatStartTime as Date, _
                                ByVal pdatEndTime as Date)
    
    On Error GoTo ErrorHandler
        Dim cnnCurrent As New ADODB.Connection
        Dim rstCurrent As New ADODB.Recordset
        Dim strSQL As String
        Dim intCounter as Integer
        Dim datCurrentDate as Date
    'Init
        Set cnnCurrent = CurrentProject.Connection
        strSQL = "SELECT keyClientID, keyEmpID, ,StartofCare, Mon, Tues, Sun, StartTime, EndTime " & _
                 "FROM YOUR_TABLE_NAME;"
        rstCurrent.Open strSQL, cnnCurrent, adOpenKeyset, adLockOptimistic
        datCurrentDate = pdatStartDate
        intCounter = 1
        datCurrentDate = pdatStartOfCare
        Do Until pintNumberOfOccurances> intCounter
                 With rstCurrent
                    .AddNew
                        !keyClientID = plngkeyClientID
                        !keyEmpID = plngkeyEmpID
                        !StartofCare = datCurrentDate
                        !Mon = pfMon
                        !Tues = pfTues
                        !Sun = pfSun
                        !StartTime = pdatStartTime
                        !EndTime = pdatEndTime
                    .Update
                End With
            End If
            intCounter = intCounter + 1
            datCurrentDate = datCurrentDate + 7
        Loop
    Exit Sub
    ErrorHandler:
            Case Else
                MsgBox Err.Number & Chr(10) & Chr(10) & Err.Description
                Resume Next
        End Select
    End Sub
    Thank you very much. Sorry I wasn't clear. Your assumptions were correct. Basically StartOfCare is a date which is always a Monday and all schedules are created by week.
    I haven't tried the code yet but will play with it today. It makes sense to me but would have taken me a week to put together myself.
    So thanks again!

    CP

  5. #5
    Join Date
    Sep 2003
    Location
    MN US
    Posts
    313
    This is working better than I had hoped. Thank you again.
    I'm posting the working code here in case anyone can use it (very few changes from original code).

    /code
    Public Sub AddWeeklySched(ByVal plngkeyClientID As Long, _
    ByVal plngkeyEmpID As Long, _
    ByVal plngkeyCareType As Long, _
    ByVal pdatStartOfCare As Date, _
    ByVal pfSun As Boolean, _
    ByVal pfMon As Boolean, _
    ByVal pfTues As Boolean, _
    ByVal pfWed As Boolean, _
    ByVal pfThu As Boolean, _
    ByVal pfFri As Boolean, _
    ByVal pfSat As Boolean, _
    ByVal pintNumberOfOccurances As Integer, _
    ByVal pdatStartTime As Date, _
    ByVal pdatEndTime As Date)

    On Error GoTo ErrorHandler
    Dim cnnCurrent As New ADODB.Connection
    Dim rstCurrent As New ADODB.Recordset
    Dim strSQL As String
    Dim intCounter As Integer
    Dim datCurrentDate As Date
    'Init
    Set cnnCurrent = CurrentProject.Connection
    strSQL = "SELECT keyClientID, keyEmpID, keyCareType, StartDate, Sunday, Monday, Tuesday, Wednesday, Thursday, Friday, Saturday, StartTime, EndTime FROM tblSchedTrans;"

    rstCurrent.Open strSQL, cnnCurrent, adOpenKeyset, adLockOptimistic
    intCounter = 1
    datCurrentDate = pdatStartOfCare
    Do Until pintNumberOfOccurances < intCounter

    With rstCurrent
    .AddNew
    !keyClientID = plngkeyClientID
    !keyEmpID = plngkeyEmpID
    !keyCareType = plngkeyCareType
    !StartDate = datCurrentDate
    !Sunday = pfSun
    !Monday = pfMon
    !Tuesday = pfTues
    !Wednesday = pfWed
    !Thursday = pfThu
    !Friday = pfFri
    !Saturday = pfSat
    !StartTime = pdatStartTime
    !EndTime = pdatEndTime
    .Update
    End With
    datCurrentDate = datCurrentDate + 7
    intCounter = intCounter + 1

    Loop
    Set cnnCurrent = Nothing
    Set rstCurrent = Nothing
    Exit Sub
    ErrorHandler:
    MsgBox Err.Number & Chr(10) & Chr(10) & Err.Description
    Resume Next

    End Sub
    /code

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •