Email Macro

Question

My company has moved me to Office 365.

With my older 2016 and older Excel version, I used this code to email whole workbooks with Outlook.

Since the upgrade, this code no longer works. I get stuck at the Set OutApp=CreateObject ("Outlook.Application")

Can someone help me with a new code that will replace this?

Dim OutApp As Object

    Dim OutMail As Object

    Set OutApp = CreateObject("Outlook.Application")

    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next

    With OutMail

    .To = ""

    .CC = ""

    .BCC = ""

    .Subject = "Upload for Next Week"

    .Body = " *** In the event of pricing errors,  ***"

    .Attachments.Add ActiveWorkbook.FullName

    .Attachments.Add ("R:\***\Price Book\Price List Upload\**** PRICES\**** Price.xls")

    .Send

    Application.Wait (Now + TimeValue("0:00:02"))

    Application.SendKeys "%s"

    End With

    On Error GoTo 0

    Set OutMail = Nothing

    Set OutApp = Nothing

Answer 1

Is Outlook running when you use the macro?

Try using

On Error Resume Next

Set OutApp = GetObject(, "Outlook.Application")

      If Err <> 0 Then

            Set OutApp = CreateObject("Outlook.Application")

            bStarted = True

      End If

On Error GoTo 0

and then at the end

If bStarted Then

    OutApp.Quit

End If

Set OutMail = Nothing

Set OutApp = Nothing