This code used to work with previous XP and Office versions. Now it does not create an email as it should. I've searched and it looks to me that the code is all still correct. And the Macro does not throw any error, it just doesn't make the email. It just goes merrily along like it wasn't even there. Any help?
Sub Send_Emails() 'Last macro that makes the emails and summary email Dim OutApp As Object Dim OutMail As Object Dim strbody As String Dim supplier_name Dim supplier_email Dim signed Sheets("Scorecard Data").Select For Each Worksheet_Var In ActiveWorkbook.Worksheets ActiveSheet.Next.Select If ActiveSheet.Name = "Summary" Then GoTo 9: End If supplier_name = Range("c4").Value supplier_email = Range("j5").Value ActiveSheet.Select ActiveSheet.Copy Application.DisplayAlerts = False ActiveWorkbook.SaveAs Filename:= _ Environ("userprofile") & "\documents\" & "Scorecard", _ FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False, ConflictResolution:=2 ActiveWorkbook.Close SaveChanges:=False Application.DisplayAlerts = True ' Make the Emails Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0) strbody = "email message body" signed = "signature" On Error Resume Next With OutMail .To = supplier_email .CC = "" .BCC = "" .Subject = supplier_name & ", Supplier Scorecard - " & Date .Body = strbody & signed 'You can add a file like this .Attachments.Add (Environ("userprofile") & "\documents\" & "Scorecard") .Display 'use .Display or .Send End With On Error GoTo 0 Set OutMail = Nothing Set OutApp = Nothing Next