Dagnaam bij de datum plaatsen

[remmie63]

Hallo, ik heb een programmacode om op jaarbasis de werkdagen van de week aan te maken voor de registratie van personen.
Zoals het nu werkt zie ik alleen de dagdatum en het zou een stuk makkelijker werken als ik bij de datum ook te zien kreeg om welke dag het gaat. Wie kan mij hierbij helpen? Bij voorbaat dank.

Option Compare Database
''Option Explicit
Dim rst As ADODB.Recordset
Dim teller As Integer, i As Integer
Dim sDatum As Date, StartDatum As Date, EindDatum As Date
Dim strBefore, strAfter As String
Dim r As ADODB.Recordset
Dim db As Database
Dim qdf As QueryDef
Dim iStart As Long, iEind As Long
Dim strSQL As String
Dim qTmp As QueryDef

Private Sub cmdDatumToevoegen_Click()

    DatumToevoegen "Werkdag", "Presentie vrijwilligers"

End Sub

Sub Test()
Dim strSQL As String

    StartDatum = DateSerial(Year(Date), 1, 1)
    teller = 1
    Set rst = New ADODB.Recordset
    rst.Fields.Append "Testnr", adInteger
    rst.Fields.Append "Datum", adDate
    rst.Open
    Do Until sDatum = DateSerial(Year(StartDatum) + 1, 1, 1)
        rst.AddNew
        rst!testnr = teller
        rst!Datum = sDatum
        rst.Update
        teller = teller + 1
        sDatum = sDatum + 1
    Loop
 
 'de recordset sorteren op testnr
    rst.MoveFirst
    Do Until rst.EOF
        strAfter = strAfter & rst.Fields("Datum") & " - " & rst.Fields("testnr") & vbCrLf
        Debug.Print rst!testnr
        rst.MoveNext
    Loop
    rst.Close
    Set rst = Nothing
    MsgBox strAfter


strSQL = "SELECT Tdatarangeinvoer.Id, Tdatarangeinvoer.naam, tDatum.Werkdag, Tdatarangeinvoer.begindatum, Tdatarangeinvoer.einddatum"
strSQL = strSQL & "FROM Tdatarangeinvoer, tDatum"
strSQL = strSQL & "WHERE (((tDatum.Werkdag) Between [begindatum] And [einddatum]))"
strSQL = strSQL & "ORDER BY Tdatarangeinvoer.naam, tDatum.Werkdag;"

End Sub

Private Sub cmdUnboundRecordset_Click()

    DatumTabel

''''strSQL = "Select * FROM tDatum"
''''
''''Set db = CurrentDb()
''''''On Error Resume Next
''''db.QueryDefs.Delete ("qTemp")
''''tmp = db.CreateQueryDef("qTemp")
''''
''''Set qTmp = db.QueryDefs("qTemp")
''''
''''''tmp = InputBox("", "", strSQL)
''''qTmp.SQL = strSQL
''''
''''Debug.Print strSQL
''''
''''DoCmd.Close acForm, Me.Form.Name
''''DoCmd.OpenQuery "qTemp"
''''
End Sub

Sub CreateQueryDefX()

   Dim dbsNorthwind As Database
   Dim qdfTemp As QueryDef
   Dim qdfNew As QueryDef

   Set dbsNorthwind = OpenDatabase("Northwind.mdb")

   With dbsNorthwind
      ' Create temporary QueryDef.
      Set qdfTemp = .CreateQueryDef("", "SELECT * FROM Employees")
      ' Open Recordset and print report.
      GetrstTemp qdfTemp
      ' Create permanent QueryDef.
      Set qdfNew = .CreateQueryDef("NewQueryDef", _
         "SELECT * FROM Categories")
      ' Open Recordset and print report.
      GetrstTemp qdfNew
      ' Delete new QueryDef because this is a demonstration.
      .QueryDefs.Delete qdfNew.Name
      .Close
   End With

End Sub

Function GetrstTemp(qdfTemp As QueryDef)

   Dim rstTemp As Recordset

   With qdfTemp
      Debug.Print .Name
      Debug.Print "  " & .SQL
      ' Open Recordset from QueryDef.
      Set rstTemp = .OpenRecordset(dbOpenSnapshot)

      With rstTemp
         ' Populate Recordset and print number of records.
         .MoveLast
         Debug.Print "  Number of records = " & _
            .RecordCount
         Debug.Print
         .Close
      End With

   End With

End Function

Sub ClientServerX2()

   Dim dbsCurrent As Database
   Dim qdfBestSellers As QueryDef
   Dim qdfBonusEarners As QueryDef
   Dim rstTopSeller As Recordset
   Dim rstBonusRecipients As Recordset
   Dim strAuthorList As String

   ' Open a database from which QueryDef objects can be
   ' created.
   Set dbsCurrent = OpenDatabase("DB1.mdb")

   ' Create a temporary QueryDef object to retrieve
   ' data from a Microsoft SQL Server database.
   Set qdfBestSellers = dbsCurrent.CreateQueryDef("")
   With qdfBestSellers
      ' Note: The DSN referenced below must be configured to
      '       use Microsoft Windows NT Authentication Mode to
      '       authorize user access to the Microsoft SQL Server.
      .Connect = "ODBC;DATABASE=pubs;DSN=Publishers"
      .SQL = "SELECT title, title_id FROM titles " & "ORDER BY ytd_sales DESC"
      Set rstTopSeller = .OpenRecordset()
      rstTopSeller.MoveFirst
   End With

   ' Create a temporary QueryDef to retrieve data from
   ' a Microsoft SQL Server database based on the results from
   ' the first query.
   Set qdfBonusEarners = dbsCurrent.CreateQueryDef("")
   With qdfBonusEarners
      ' Note: The DSN referenced below must be configured to
      '       use Microsoft Windows NT Authentication Mode to
      '       authorize user access to the Microsoft SQL Server.
      .Connect = "ODBC;DATABASE=pubs;DSN=Publishers"
      .SQL = "SELECT * FROM titleauthor WHERE title_id = '" & rstTopSeller!title_id & "'"
      Set rstBonusRecipients = .OpenRecordset()
   End With

   ' Build the output string.
   With rstBonusRecipients
      Do While Not .EOF
         strAuthorList = strAuthorList & "  " & !au_id & ":  $" & (10 * !royaltyper) & vbCr
         .MoveNext
      Loop
   End With

   ' Display results.
    MsgBox "Please send a check to the following authors in the amounts shown:" & vbCr _
        & strAuthorList & "for outstanding sales of " & rstTopSeller!Title & "."
    rstTopSeller.Close
    dbsCurrent.Close

End Sub

[OctaFish]

Je kunt een datum heel simpel met een andere notatie ook de dag laten zien: ddd dd-mm-yyyy. Is dat niet al voldoende?

[remmie63]

Zo eenvoudig kan het zijn! Bedankt!

[OctaFish]

Als aanvulling nog twee functies die meer velden vullen. Die heb je dus niet meer nodig, maar dan heb je een beetje een idee hoe het werkt

Eerst een methode die gebruik maakt van de ADO bibliotheek:

Function WerkDagen_ADO()
Dim rst As ADODB.Recordset
Dim conn As ADODB.Connection
Dim strSQL As String
Dim iStart As Long, iEind As Long
Dim SortArray As Variant

    iStart = CDbl(DateSerial(Year(Date), 1, 1))
    iEind = CDbl(DateSerial(Year(Date) + 1, 1, 1))

    Set rst = New ADODB.Recordset
    Set conn = CurrentProject.Connection
    With rst
        .ActiveConnection = conn
        .CursorType = adOpenDynamic
        .CursorLocation = adUseClient
        .LockType = adLockOptimistic
        .Open "Werkdag"
        Do While iStart < iEind
            If WeekDay(CDate(iStart), vbMonday) < 6 Then
                .AddNew
                !Werkdag = CDate(iStart)
                !Dag = Format(CDate(iStart), "dddd")
                .Update
            End If
            iStart = iStart + 1
        Loop
        rst.Close
    End With
    Set rst = Nothing

End Function

En deze maakt gebruik van de DAO bibliotheek:

Function Werkdagen_DAO()
Dim iStart As Long, iEind As Long

    iStart = CDbl(DateSerial(Year(Date), 1, 1))
    iEind = CDbl(DateSerial(Year(Date) + 1, 1, 1))

    With CurrentDb.OpenRecordset("Werkdagen")
        Do While iStart < iEind
            If WeekDay(CDate(iStart), vbMonday) < 6 Then
                .AddNew
                !Werkdag = CDate(iStart)
                !Dag = Format(CDate(iStart), "dddd")
                .Update
            End If
            iStart = iStart + 1
        Loop
        .Close
    End With

End Function