I am trying to run a code that automatically sends out emails to different accounts. Attached is my code, that when ran, has error 424, or 9 out of range. If someone can take a quick look at it and see if I'm missing something obvious, that would be great.
Sub Send_Files()
'Working in Excel 2000-2016
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim email_sh As Worksheet
Set email_sh = wb.Sheets("E-mail List")
Dim shRef As Worksheet
Set shRef = wb.Sheets("Reference")
Dim cell As Range
Dim LastRow As Long
Dim FileCell As Range
Dim rng As Range
'With Application
' .EnableEvents = False
' .ScreenUpdating = False
'End With
Set OutApp = New Outlook.Application
LastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
For Each cell In email_sh.Range(Cells(1, 1), Cells(LastRow, 1))
'Enter the path/file names in the F:Z column in each row
'Set rng = sh.Cells(cell.Row, 3).Range("F1:Z1")
If cell.Offset(0, 2).Value Like "?*@?*.?*" Then
'And Application.WorksheetFunction.CountA(rng) > 0
Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail
.To = email_sh.Cells(cell.Row, 3).Value
.CC = email_sh.Cells(cell.Row, 4).Value
.Subject = email_sh.Cells(cell.Row, 5).Value
.Body = shRef.Range("I2").Value
If Trim(email_sh.Cells(cell.Row, 6).Value) <> "" Then
If Dir(email_sh.Cells(cell.Row, 6).Value) <> "" Then
.Attachments.Add email_sh.Cells(cell.Row, 6).Value
End If
End If
' For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
' If Trim(FileCell.Value) <> "" Then
' If Dir(FileCell.Value) <> "" Then
' .Attachments.Add FileCell.Value
' End If
' End If
' Next FileCell
'.Send or
.Display
End With
Set OutMail = Nothing
End If
Next cell
End Sub