Help to amend vba to highlight any cells where file paths do not exists
Hi, i'm hoping someone can help me adjust this code from Ron de Bruin. It attaches documents to an outlook email, where the file path is in cell E and F. It works great but I'd like to highlight the cells in E or F in yellow of any file paths which don't exist and therefore cannotbe attached. For example the file path is column E may attach but the one if column F may be typed incorrectly or may not exists so cannot be attached. I'd like to know if any are missing so I can correct them. Is this possible? Ive attached copy of the code. Many thanks
Code:
Sub Send_Files()
'Working in Excel 2000-2016
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
Dim OutApp As Object
Dim OutMail As Object
Dim sh As Worksheet
Dim cell As Range
Dim FileCell As Range
Dim rng As Range
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set sh = Sheets("Sheet1")
Set OutApp = CreateObject("Outlook.Application")
For Each cell In sh.Columns("A").Cells.SpecialCells(xlCellTypeConstants)
'Enter the path/file names in the E:F column in each row
Set rng = sh.Cells(cell.Row, 1).Range("E1:F1")
If cell.Value Like "?*@?*.?*" And _
Application.WorksheetFunction.CountA(rng) > 0 Then
Set OutMail = OutApp.CreateItem(0)
With OutMail
.to = sh.Cells(cell.Row, 1).Value
.CC = sh.Cells(cell.Row, 2).Value
.Subject = sh.Cells(cell.Row, 3).Value
.Body = sh.Cells(cell.Row, 4).Value
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
.display 'Or use .Display/Send
End With
Set OutMail = Nothing
End If
Next cell
Set OutApp = Nothing
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
