Excel - Outlook - Multiple Email Code - Nothing happening on Outlook

[stokebrough]

I'm using the below code to send multiple emails to various address with differing attachments. However once I press 'Run' nothing is happening. I have used this multiple times with outlook but it doesn't seem to be picking it up? Any suggestions?

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 D:Z column in each row
Set rng = sh.Cells(cell.Row, 1).Range("D1:Z1")

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 = "Task Orders 04/01/2019 to 11/01/2019"
.Body = sh.Cells(cell.Row, 3).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

.Send '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

 

[stokebrough]

I'm using the Macro on Excel. However nothing happens on Outlook - This was working just a few days ago - Anyone any ideas?

 

[Logit]

.
First question : If it ran successfully a few days ago ... what has changed with your computer since then ?

MS software update ?

Did you edit the code ?

Has your sheet row/column locations changed relative to the macro code ?


If nothing has changed ... try copying the macro and paste into a new workbook and run the macro there.

 

[stokebrough]

The code/sheet are all the same - Which is why I assume it's something to do with Outlook; I haven't seen any updates but not 100% as it's a works laptop. I've tried using a new workbook also.

Do I need to change any settings?

 

[Logit]

.
My first thought is: if it worked several days ago, obviously it should be working now. If nothing has changed, then perhaps somehow
the workbook became corrupted. It does occur without warning.

I have not reviewed your code ... base my response on your contention that it worked previously ... copy the code to a new workbook and run from there.

 

[stokebrough]

No it hasn't worked. I did try this before to be honest.

Do you know any posts where I could find a different code maybe with similar outcome to try instead; this could prove if the problem lies with Outlook. I need a column for addresses for the main contact of email; column for any to CC; column for the Body of email & column for the path which the attachments will be in?

Or any other hep/advice would be appreciated. I have to send different emails with attachments to 100+ contacts frequently and this not working for no apparent reason has become a BIG set back.

Thanks

 

[Logit]

http://www.rondebruin.nl/win/section1.htm