Access VBA

css navigation by Css3Menu.com

Build Report on Row Number

After I aquired a lot of information about previous presentations at my club, I decided to add it all to my Access database to make reports.

I am putting the final result into a HTML page with odd/even rows having different colored backgrounds.

   Set DB = CurrentDb()
    Dater = InputBox("What is the earlist date to show?", "Club Programs", Now() - 30)
    Sql1 = "SELECT tblClubPrograms.ClubID, tblClubPrograms.PresDate, tblClubPrograms.PresTime, tblClubPrograms.ZoomLink, " & vbCrLf
    Sql1 = Sql1 & " tblClubPrograms.Presenter , tblClubPrograms.PPname, tblClubPrograms.OutOfTown, tblClubPrograms.InPerson, " & vbCrLf
    Sql1 = Sql1 & " tblClubPrograms.Description"
    Sql1 = Sql1 & " From tblClubPrograms" & vbCrLf
    Sql1 = Sql1 & " WHERE (((tblClubPrograms.ClubID)=4) AND ((tblClubPrograms.PresDate)>=#" & Dater & "#))"
    Sql1 = Sql1 & " ORDER BY tblClubPrograms.PresDate;"
 'Debug.Print Sql1
    Select Case PrgYr
        Case 6   'Yes
            DtFor = "mmmm dd, yyyy"
        Case 2
            DtFor = "MMMM DD"
    End Select
    
    Open KeyVal("WebstFile") For Output As #1
    Set RS = DB.OpenRecordset(Sql1, dbOpenDynaset)
        RS.MoveFirst
        Do While Not RS.EOF
            If RS.AbsolutePosition Mod 2 = 0 Then    'Determine if even or odd numbered row
          Select Case RS!OutOfTown   'Odd Row
            Case False
                Print #1, TRc & Tabhd & Format(RS!PresDate, DtFor) & Thd & ColN & RS!PPname & nob & TDe & ColN & RS!Presenter _
            & nob & TDe & TRe
            Case True
                Print #1, TRc & Tabhd & Format(RS!PresDate, DtFor) & Thd & ColN & RS!PPname & nob & TDe & ColN & RS!Presenter _
            & OOT & nob & TDe & TRe
        End Select
            Else     'Even row
        Select Case RS!OutOfTown
            Case False
                Print #1, TRc & Tabhd & Format(RS!PresDate, DtFor) & Thd & ColAlt & RS!PPname & nob & TDe & ColAlt & RS!Presenter _
            & nob & TDe & TRe
            Case True
                Print #1, TRc & Tabhd & Format(RS!PresDate, DtFor) & Thd & ColAlt & RS!PPname & nob & TDe & ColAlt & RS!Presenter _
            & OOT & nob & TDe & TRe
        End Select
        End If
        RS.MoveNext
        Loop
     Close #1

    MsgBox "Done"
cmdSocProg_Click_Exit:
    Exit Sub

cmdSocPg_Click_Err:
    MsgBox Error$
    Resume cmdSocProg_Click_Exit
End Sub

The final result may be a little long but check this page..

© 2022-2024

Updated:  04/17/2024 12:26
This page added:  16 May 2022