I am running the following sub and using AppActivate at the end to reset the
focus to Excel.

This seemed to be working, but not presently. can you help with the syntax
on this. I have tried:

AppActivate "Microsoft Excel"
AppActivate ("Dashboard.xlsm - Microsoft Excel")
AppActivate ("Dashboard.xlsm")

If there is another approach that is reliable, please let me know.

Any help with this is greatly appreciated.



Sub Mail_ActiveSheet_PDF_Outlook(i)
'Note: It is easy to change the code to send a workbook, selection or range.
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Dim FilenameStr As String

' for this column (i), start adding all emails found to string called
"emails"
' stop when no more emails are found
j = 6
emails = ""
Do While (Worksheets("Labels").Cells(j, i) < Empty)
emails = emails & Worksheets("Labels").Cells(j, i).Value & ";"
j = j + 1
Loop

If Dir(Environ("commonprogramfiles") & "\Microsoft Shared\OFFICE" _
& Format(Val(Application.Version), "00") & "\EXP_PDF.DLL") < "" Then

FilenameStr = Application.DefaultFilePath & "\" & _
Format(Sheets("Convert").Range("BP3").Value, "dd-mmm-yy") _
& ReportName _
& ".pdf"

ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=FilenameStr, _
Quality:=xlQualityMinimum, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False

Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)

'On Error Resume Next
With OutMail
.To = emails
.CC = ""
.BCC = ""
.Subject = Worksheets("Labels").Cells(4, i).Value & " - " & _
Sheets("Main").Range("AB8").Value
.Body = "Reports attached"
.Attachments.Add FilenameStr
.Send 'or use .Display
End With
'On Error GoTo 0

'Delete the pdf you send
Kill FilenameStr

Set OutMail = Nothing
Set OutApp = Nothing
Else
MsgBox "PDF add-in Not Installed"
End If

AppActivate "Microsoft Excel"

End Sub