Sum Of Records By Year And Month

[DMT Dave]

Hi Guy's I need a little guidance/correction on this one please ?

I am trying to loop though months in reverse order of what has been delivered and sum the values to display on an email per (2 items delivered) typeF and typeH (2 different products)

I don't have Year or Month Field names, I am struggling to find out how to extract Year and Month from Recordset rs.deliverydate !! and loosing myself in trying!!!

All field names are correct, I have removed some information from this code, mainly addresses and product type

Is it possible to achieve this ?

so the end result on the email would be:





tblStart
Total ItemTypeF delivered 2022 month 5 = 999
Total ItemTypeH delivered 2022 month 5 = 457
tblend

tblStart
Total ItemTypeF delivered 2021 month 5 = 900
Total ItemTypeH delivered 2021 month 5 = 506
tblend

tblStart
Total ItemTypeF delivered 2020 month 5 = 950
Total ItemTypeH delivered 2020 month 5 = 387
tblend

etc etc....

Dim rs As DAO.Recordset, rsCust As DAO.Recordset, rsType As DAO.RecordsetDim strType As String, strBody As String, strtblStart As String, strtblEnd As String, FontStart As String, FontEnd As String, myMonth As String
Dim strWKR As String, SigFile As String, myUser As String, myUserFullName() As String, userFname As String, eDisc As String, eDisc2 As String, TOD As String, TimeNow As String
Dim strCust As String, strMyCust As String, strTypeF As String, strTypeH As String, strIntro As String
Dim myApp As New Outlook.Application, myItem As Outlook.MailItem, OutAccount As Outlook.Account
Dim varCust As Variant, varCustOpt As Variant, varCustSelect As Variant, varType As Variant
Dim iCust As Integer, iType As Integer, i As Integer, iMonth As Integer, iYearNow As Integer, iYear As Integer, iFSum As Integer, iHSum As Integer


eDisc = "Removed is a limited company registered in England and Wales, Registered number: removed." & vbNewLine & _
"Registered office:Removed"
eDisc2 = "This message and any associated files is intended only for the use of the named recipient(s) and may contain information which is confidential, subject to copy write or constitutes a trade secret." & vbNewLine & _
"If you are not the name recipient(s) you are hereby notified that any copying or distribution of this message, or files associated with this message, is strictly prohibited." & vbNewLine & _
"If you have received this message in error, please notify us immediately by replying to this email and deleting from your computer." & vbNewLine & _
"Any files attached to this email will have been checked with anti virus detection software prior to sending, but you should carry out your own virus check before opening any attachment." & vbNewLine & _
"removed do not accept liability for any loss or damage which may be caused by software viruses."


myMonth = Format(Now(), "mm")
If myMonth <> "12" Then
SigFile = "DMT dispatch@ Email Signature.jpg"
Else
SigFile = "DMT Xmas Signature.jpg"
End If


TimeNow = Format(Now(), "hh")
If TimeNow <= 12 Then
TOD = "Good Morning"
End If
If TimeNow >= 17 Then
TOD = "Good Evening"
End If
If TimeNow >= 12 Then
If TimeNow <= 17 Then
TOD = "Good Afternoon"
End If
End If


myUser = Forms!frmMainMenu!txtLogin
myUserFullName = Split(myUser, " ")
userFname = myUserFullName(0)


varCust = InputBox("Enter Abbreviated Customer Name ?", "ENTER ABBR CUSTOMER NAME")
    Set rsCust = CurrentDb.OpenRecordset("Select * From tblCustomers WHERE Name Like ""*" & varCust & "*""")
    Do Until rsCust.EOF
    strCust = strCust & Chr(149) & " " & rsCust.Fields("RecordNo") & " " & Chr(149) & " " & rsCust.Fields("Name") & vbNewLine
    rsCust.MoveNext
    Loop


    varCustOpt = InputBox("Enter Number Of The Customer ?" & vbNewLine & vbNewLine & _
    strCust & vbNewLine & vbNewLine & _
    Chr(149) & " Leave Blank To Abort" & " " & Chr(149), "ENTER CUSTOMER NUMBER")
    
    If varCustOpt = "" Then
        Exit Sub
    Else
        strMyCust = DLookup("Name", "tblCustomers", "[RecordNo] = " & varCustOpt)
    End If
        
        strTypeF = "removed"
        strTypeH = "removed"
        strSRC = "Acc"
        strWKR = "With Kind Regards"
        strtblStart = "<table style='text-align:left;border:1px solid black;font-family:calibri;border-collapse:collapse;padding:25px'><tr style='background:white;mso-highlight:blue'>"
        strtblEnd = "</tr></table>"
        
        Set rs = CurrentDb.OpenRecordset("Select tblAssign.Customer, tblAssign.Source, tblAssign.Type, tblAssign.DeliveryDate, " _
        & "tblAssign.Type, " _
        & "FROM tblAssign, " _
        & "WHERE Customer = '" & strMyCust & "' " _
        & "AND Source = '" & strSRC & "' ORDER BY DeliveryDate DESC")
        
        Do Until rs.EOF
            iYearNow = Format(rs.Fields("DeliveryDate"), "yyyy")
            iYear = iYearNow - 1

            iMonth = InputBox("Enter Month Number" & vbNewLine & vbNewLine & _
            "Default Is This Month", "ENTER MONTH NO ?", Format(Now(), "mm"))



            iFSum = DSum(rs.Fields("RemovedType"), "tblAssign", "[RemovedType] = '" & strTypeF & "'" & " And " & Format(rs.Fields("DeliveryDate"), "yyyy")) = " & iYear)"
            iHSum = DSum(rs.Fields("RemovedType"), "tblAssign", "[RemovedType] = '" & strTypeH & "'" & " And " & Format(rs.Fields("DeliveryDate"), "mm")) = " & iMonth)"
        rs.MoveNext
        Loop
        
        strBody = strtblStart & "|" & "Total " & strTypeF & " Delivered In Year " & rs.Fields("Year") & ": " & iFSum & "||" & _
        "Total " & strTypeF & " Delivered In Month " & rs.Fields("Month") & ": " & iHSum & "|" & strtblEnd
        
        Debug.Print strBody
        
        strInto = "Below Are Delivery Statistics For Each Month||"
        
        Set myItem = myApp.CreateItem(olMailItem)
        Set OutAccount = myApp.Session.Accounts.Item(1)
        With myItem
        .subject = "Monthly Stats"
        .To = ""
        .HTMLBody = Replace(strIntro, "|", "<br>") & "<br>" & "<br>" & Replace(strBody, "|", "<br>" & "<br>") & "<br>" & _
        strWKR & "<br>" & "<br>" & _
        userFname & "<br>" & "<br>" & _
        "<P><IMG border=0 hspace=0 alt='' src='file://T:/DMT Ltd/Logo Media/" & SigFile & "' align=baseline></P>" & "<br>" & "<br>" & _
        "<FONT color=#00008B>" & eDisc & "<br>" & "<FONT color =#00008B>" & eDisc2
        .SendUsingAccount = OutAccount
        .Display
        End With

[Welshgasman]

Use Year() and Month() functions?

[Minty]

As per the WGM, but put the values into your recordset as calculated fields

MyMonth : Month([DispatchDate])
MyYear : Year([DispatchDate])

This will be quicker as a one off part of your query and saves doing the calculation it in the loop.

Also just cos' you can tidy this up significantly

Function fnGreeting() As String


    Select Case TimeValue(Now())
        Case Is <= 12
            fnGreeting = "Good Morning"
        Case Is >= 17
            fnGreeting = "Good Evening"
        Case Else
            fnGreeting = "Good Afternoon"
    End Select


End Function