I want to send an Outlook email with range from Excel sheet when the Computer is locked
I am running a dashboard which refreshes weekly, using an ODBC connection. I have written a macro which runs on auto_open. The file is opened by Task Scheduler.
System: Windows 7 SP1, Outlook 2016, Excel 2016
Problem: When I schedule the task with the setting as Run whether user is logged on or not, the Excel file opens and gets refreshed, but it does not send the mail, nor does it appear in my outbox. The refresh does happen successfully though. This is when the user is not logged on. What I meant was that the computer is locked.
The task schedule works fine when the user is logged on
I have tried this Excel VBA - Email Does not Send When Computer is Locked and it did not work for me.
The function I am using for sending the mail is:
Dim oApp As Object, OutApp As Object, OutMail As Object
Dim rng As Range
Dim strbody As String, strtail As String
strbody = "Hi team," & "<br>" & _
"<a href=""https://example.com"">Here</a> is the link to cloud upload" & Worksheets("Core View").Range("M2") & "<br><br>"
strtail = "Thanks," & "<br>" & _
"Team." & "<br><br>"
On Error Resume Next
'Only the visible cells in the selection
'Set rng = Selection.SpecialCells(xlCellTypeVisible)
Set rng = Sheets("Core View").Range("A7:K106").SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If rng Is Nothing Then
MsgBox "The selection is not a range or the sheet is protected. " & _
vbNewLine & "Please correct and try again.", vbOKOnly
End If
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
'Create the mail
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = "plaknas@example.com"
.CC = ""
.BCC = ""
If EmptySheets <> "" Then
.Subject = "update has issues in " & EmptySheets
Else
.Subject = "Update for week" & Worksheets("Core View").Range("M2")
End If
.HTMLBody = strbody & RangetoHTML(rng) & strtail
.Send 'or use .Display
End With
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Function