Hi,

I have recently tried to automate sending reports to different people. The code is looping when i run it, but i can't find the saved pdf files nor any emails being sent out. just to touch base. Sheet 4 (B1 = user) is where the report is. Sheet 5 is where the emails are (First row = player code, second row = first name, third row = emails) (3 + Sheet5.Range = 16) . This code was adapted from someone's work, but unfortunately i am unable to contact that person, hence why i ask for you help. Any help will be greatly appreciated.

Sub emailer()

Dim TempFilePath As String
Dim TempFileName As String
Dim OutAPP As Object
Dim OutMail As Object
Dim Athlete As String
Dim AthleteFirstname As String
Dim fullfilename As String
Dim athletecount_start As Integer
Dim athletecount_end As Integer
Dim athletemail As String
Dim i As Integer
Dim reportstoragefolder As String
Dim reportdate As Date

reportstoragefolder = "F:"
reportdate = Sheet4.Range("D13").Value

athletecount_start = 6
athletecount_end = 3 + Sheet5.Range("F3").Value


Sheet4.Select


For i = athletecount_start To athletecount_end


Sheet4.Range("B1").Value = Sheet5.Cells(i, 1).Value


Application.Calculate



Athlete = Sheet4.Range("B1").Value & " - " & Format(reportdate, "dd-mm-yyyy")
AthleteFirstname = Sheet5.Cells(i, 2)


fullfilename = reportstoragefolder & Athlete & ".pdf"


ActiveSheet.ExportAsFixedFormat Type:=x1TypePDF, Filename:= _
fullfilename, Quality:=x1QualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False




Set OutAPP = CreateObject("Outlook.Application")
Set OutMail = OutAPP.CreateItem(0)


On Error Resume Next
With OutMail
.To = Sheet5.Cells(i, 3)
.CC = ""
.BCC = ""
.Subject = "Seven Day Training Load Update" & "-" & Format(reportdate, "dd-mm-yyyy")
.Body = "Hi " & AthleteFirstname & ", attached is the report from the last seven days"


.Attachments.Add fullfilename
.Send
End With
On Error GoTo 0

Next i

End Sub