My prorgam is sending out old emails

[treefarmer]

I wrote a program to send out figure skating bills for my wife's business. But it for some reason sends out old invoices from months ago.

I'm thinking there must be something in Outlook that I should be clearing so this doesn't happen?

Here is my code. It uses a spreadsheet in Excel and then sends a pdf of the skater's invoice in Outlook.

I bolded the part that creates the emails



Sub Save_as_PDF()

Dim Cnt As Integer
Dim Comp As Boolean
Dim CompSkaters As Integer
Dim EventCost As Integer
Dim Mileage As Integer
Dim CostPerKM As Single
Dim Food As Single
Dim Hotel As Single
Dim LateFee As Integer

EventCost = 20
CostPerKM = 0.48
LateFee = 20

Dim OutlookApp As Object
Dim OutlookMail As Object

If Worksheets(1).Range("F26") <> 0 Or Worksheets(1).Range("F27") <> 0 Or Worksheets(1).Range("F28") <> 0 Then 'checks if there is a competition and how many skaters went
Comp = True
Cnt = 1
Do While Worksheets(1).Cells(3, Cnt * 4 - 2) <> ""
If Worksheets(1).Cells(21, Cnt * 4 - 2) <> 0 Then
CompSkaters = CompSkaters + 1
End If
Cnt = Cnt + 1
Loop
Mileage = Worksheets(1).Range("F26")
Hotel = Worksheets(1).Range("F27")
Food = Worksheets(1).Range("F28")
Else
Comp = False
End If

For Cnt = 3 To Worksheets.Count

If Worksheets(Cnt).Range("E28") <> 0 Or Worksheets(1).Cells(21, Cnt * 4 - 10) <> 0 Or Worksheets(1).Cells(19, Cnt * 4 - 10) <> 0 Then 'if the owe something

If Worksheets(1).Cells(19, Cnt * 4 - 10) <> 0 Then 'adds past due and late fees to invoice

Worksheets(Cnt).Cells(28, 3) = "Current Bill"
Worksheets(Cnt).Cells(29, 3) = "Past Due"
Worksheets(Cnt).Cells(29, 3).Font.Bold = True
Worksheets(Cnt).Cells(29, 5) = Worksheets(1).Cells(19, Cnt * 4 - 10)
Worksheets(Cnt).Cells(29, 5).NumberFormat = "$#,##0.00"
Worksheets(Cnt).Cells(29, 5).HorizontalAlignment = xlCenter
Worksheets(Cnt).Cells(29, 5).Font.Bold = True
Worksheets(Cnt).Cells(30, 3) = "Late Charge"
Worksheets(Cnt).Cells(30, 3).Font.Bold = True
Worksheets(Cnt).Cells(30, 5) = LateFee
Worksheets(Cnt).Cells(30, 5).NumberFormat = "$#,##0.00"
Worksheets(Cnt).Cells(30, 5).HorizontalAlignment = xlCenter
Worksheets(Cnt).Cells(30, 5).Font.Bold = True
Worksheets(Cnt).Cells(31, 3) = "Total"
Worksheets(Cnt).Cells(31, 3).Font.Bold = True
Worksheets(Cnt).Cells(31, 5) = Worksheets(Cnt).Cells(29, 5) + Worksheets(Cnt).Cells(28, 5) + Worksheets(Cnt).Cells(30, 5)
Worksheets(Cnt).Cells(31, 5).NumberFormat = "$#,##0.00"
Worksheets(Cnt).Cells(31, 5).HorizontalAlignment = xlCenter
Worksheets(Cnt).Cells(31, 5).Font.Bold = True

End If

If Comp = True And Worksheets(1).Cells(21, Cnt * 4 - 10) <> 0 Then 'adds competition to individual invoices

If Worksheets(Cnt).Cells(31, 5) <> 0 Then
Worksheets(Cnt).Cells(31, 3) = "Sub-Total"
Else
Worksheets(Cnt).Cells(28, 3) = "Sub-Total"
End If
Worksheets(Cnt).Cells(33, 3) = Worksheets(1).Cells(21, Cnt * 4 - 10) & " Event(s)"
Worksheets(Cnt).Cells(33, 5) = EventCost * Worksheets(1).Cells(21, Cnt * 4 - 10)
Worksheets(Cnt).Cells(33, 5).HorizontalAlignment = xlCenter
Worksheets(Cnt).Cells(33, 5).NumberFormat = "$#,##0.00"
Worksheets(Cnt).Cells(34, 3) = "Mileage: " & Mileage & " km"
Worksheets(Cnt).Cells(34, 5) = Mileage * CostPerKM / CompSkaters
Worksheets(Cnt).Cells(34, 5).HorizontalAlignment = xlCenter
Worksheets(Cnt).Cells(34, 5).NumberFormat = "$#,##0.00"
Worksheets(Cnt).Cells(35, 3) = "Hotel"
Worksheets(Cnt).Cells(35, 5) = Hotel / CompSkaters
Worksheets(Cnt).Cells(35, 5).HorizontalAlignment = xlCenter
Worksheets(Cnt).Cells(35, 5).NumberFormat = "$#,##0.00"
Worksheets(Cnt).Cells(36, 3) = "Food"
Worksheets(Cnt).Cells(36, 5) = Food / CompSkaters
Worksheets(Cnt).Cells(36, 5).HorizontalAlignment = xlCenter
Worksheets(Cnt).Cells(36, 5).NumberFormat = "$#,##0.00"
Worksheets(Cnt).Cells(37, 3) = "Competition Total"
Worksheets(Cnt).Cells(37, 3).Font.Bold = True
Worksheets(Cnt).Cells(37, 5) = (Food + Hotel + Mileage * CostPerKM) / CompSkaters + EventCost * Worksheets(1).Cells(21, Cnt * 4 - 10)
Worksheets(Cnt).Cells(37, 5).HorizontalAlignment = xlCenter
Worksheets(Cnt).Cells(37, 5).NumberFormat = "$#,##0.00"
Worksheets(Cnt).Cells(37, 5).Font.Bold = True
Worksheets(Cnt).Cells(39, 3) = "Total"
Worksheets(Cnt).Cells(39, 3).Font.Bold = True
If Worksheets(Cnt).Cells(31, 5) <> 0 Then
Worksheets(Cnt).Cells(39, 5) = Worksheets(Cnt).Cells(31, 5) + Worksheets(Cnt).Cells(37, 5)
Else
Worksheets(Cnt).Cells(39, 5) = Worksheets(Cnt).Cells(28, 5) + Worksheets(Cnt).Cells(37, 5)
End If
Worksheets(Cnt).Cells(39, 5).HorizontalAlignment = xlCenter
Worksheets(Cnt).Cells(39, 5).NumberFormat = "$#,##0.00"
Worksheets(Cnt).Cells(39, 5).Font.Bold = True

End If

With Worksheets(Cnt).PageSetup 'creates PDFs
.CenterHeader = ""
.Orientation = xlPortrait
.PrintArea = "$A$1:$E$49"
.PrintTitleRows = ActiveSheet.Rows(5).Address
.Zoom = False
.FitToPagesTall = False
.FitToPagesWide = 1
End With

Worksheets(Cnt).ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:="C:\Users\Carly and Steve\Documents\Carly skating\Invoices\Invoices Exported by Spreadsheet" & Worksheets(Cnt).Name & " " & Format(Range("A7"), "yyyy-mm-dd") & " to " & Format(Range("A18"), "yyyy-mm-dd"), _
Quality:=xlQualityStandard, _
IncludeDocProperties:=False, _
IgnorePrintAreas:=False, _
From:=1, _
To:=5, _
OpenAfterPublish:=False


Set OutlookApp = CreateObject("Outlook.Application") 'emails PDFs

If Worksheets(1).Cells(20, Cnt * 4 - 10) <> "" Then

Set OutlookMail = OutlookApp.CreateItem(0)

With OutlookMail
.To = Worksheets(1).Cells(20, Cnt * 4 - 10)
.Subject = "Invoice for Figure Skating Lessons from " & Format(Range("A7"), "yyyy-mm-dd") & " to " & Format(Range("A18"), "yyyy-mm-dd")
.BodyFormat = 2
.HTMLBody = "Please find attached your invoice for " & Format(Range("A7"), "yyyy-mm-dd") & " to " & Format(Range("A18"), "yyyy-mm-dd") & "<BR>Please pay by " & Format(DateAdd("ww", 2, Date), "yyyy-mm-dd") & " to avoid late fees.<BR>Let me know if you have any problems.<BR><BR>Thanks,<BR>Carly Dinicol"
.Attachments.Add "C:\Users\Carly and Steve\Documents\Carly skating\Invoices\Invoices Exported by Spreadsheet" & Worksheets(Cnt).Name & " " & Format(Range("A7"), "yyyy-mm-dd") & " to " & Format(Range("A18"), "yyyy-mm-dd") & ".pdf"
.Display
End With

End If

End If

Worksheets(2).Cells(Cnt, 1) = Worksheets(Cnt).Name 'creates ledger
Worksheets(2).Cells(Cnt, 2) = Worksheets(1).Cells(19, Cnt * 4 - 10)
If Worksheets(Cnt).Range("E37") = 0 Then
Worksheets(2).Cells(Cnt, 3) = Worksheets(Cnt).Range("E28")
Else
Worksheets(2).Cells(Cnt, 3) = Worksheets(Cnt).Range("E28") + Worksheets(Cnt).Range("E37")
End If
If Worksheets(2).Cells(Cnt, 2) = 0 Then
Worksheets(2).Cells(Cnt, 4) = Worksheets(2).Cells(Cnt, 3)
Else
Worksheets(2).Cells(Cnt, 4) = Worksheets(2).Cells(Cnt, 2) + Worksheets(2).Cells(Cnt, 3) + LateFee
End If
If Worksheets(2).Cells(Cnt, 4) <> 0 Then
Worksheets(2).Cells(Cnt, 6) = Format(Date, "yyyy-mm-dd")
Else
Worksheets(2).Cells(Cnt, 6) = ""
End If

Next

With Worksheets(2).PageSetup 'saves ledger
.CenterHeader = ""
.Orientation = xlPortrait
.PrintArea = "$A$1:$G$49"
.PrintTitleRows = ActiveSheet.Rows(5).Address
.Zoom = False
.FitToPagesTall = False
.FitToPagesWide = 1
End With

Worksheets(2).ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:="C:\Users\Carly and Steve\Documents\Carly skating\Invoices\Invoices Exported by Spreadsheet" & "Skater Balances " & Format(Date, "yyyy-mm-dd"), _
Quality:=xlQualityStandard, _
IncludeDocProperties:=False, _
IgnorePrintAreas:=False, _
From:=1, _
To:=5, _
OpenAfterPublish:=False

Set OutlookMail = Nothing
Set OutlookApp = Nothing

MsgBox "PDFs created and emails sent. Love you babe!"

End Sub

Thank you

[gmayor]

Without access to the workbook and little idea what it looks like it is like fishing in the dark; however it seems likely that the workbook contains lots of old sheets and it is what you are sending to Outlook that is the problem rather than Outlook itself causing the problem. I would start by investigating your loop and the use of the variable 'cnt' to ensure that it is sending the correct information.