The code's main job is to copy paste a section from Excel into a email body in Outlook 2016 and send it to the list of distributers which are pre defined.
The issue is Outlook "not responding" and closing or the code printing "error message" and not allowing the code to run until I manually close and reopen Outlook and resume the code.
The code runs on a virtual machine (VM) which is on 24/7. This problem only occurs when I'm not logged into the VM.
The code starts automatically when the bot is triggered via task scheduler.
Sub EmailReply()
Application.ScreenUpdating = False
Call OpeningDuties
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim OutNameSpace As Outlook.Namespace
Dim OutOwner As Outlook.Recipient
Dim EmailAddress As Object
Dim i As Long
' The error usually happens at this part of the code:
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)
Set OutNameSpace = OutApp.GetNamespace("mapi")
Set OutOwner = OutNameSpace.CreateRecipient("company@company.com")
OutOwner.Resolve
' the rest of the code:
Dim CopyRange As Range
Set wdDoc = OutMail.GetInspector.WordEditor
'Assign email title
SubjectText = "COMPANY RMA Results"
'Retrieve email address
Set EmailAddress = Range("Email_Address")
If EmailAddress = 0 Then
RMAStatus = "Non valid email address"
Application.ScreenUpdating = True
Exit Sub
End If
'Determining if the email should be responded in English or French
If Range("email_language") = "En" Then
FirstRow = 3
FirstColumn = 3
LastRow = 246
LastColumn = 9
ElseIf Range("email_language") = "Fr" Then
FirstRow = 3
FirstColumn = 11
LastRow = 246
LastColumn = 16
End If
'Filter template for correct email response
Sheets("Email Template").Select
Sheets("Email Template").Range(Cells(FirstRow, FirstColumn), Cells(LastRow, LastColumn)).AutoFilter Field:=1, Criteria1:="Show"
'Defines Range for Range
Sheets("Email Template").Select
Set CopyRange = Sheets("Email Template").Range(Cells(FirstRow, FirstColumn), Cells(LastRow, LastColumn)).SpecialCells(xlCellTypeVisible)
With OutMail
.To = EmailAddress
.CC = "RMA@company.com"
.SentOnBehalfOfName = "RMA@company.com"
.Subject = SubjectText
.Display
'Creating Email Summary Report
Workbooks(BOT_Filename).Activate
CopyRange.CopywdDoc.Application.Selection.PasteAndFormat Type:=wdFormatOriginalFormatting
'pastes the Text range
.Send
End With
On Error GoTo ExitSendEmail
ExitSendEmail:
Set CopyRange = Nothing
Set OutApp = Nothing
Set OutMail = Nothing
Set OutNameSpace = Nothing
Set OutOwner = Nothing
Application.ScreenUpdating = True
End Sub