Excel VBA Module won't create new e-mail in Outlook when logged out

mssbass

Board Regular
Joined
Nov 14, 2002
Messages
235
Platform
  1. Windows
I have a scheduled tasks that opens a batch file that runs an Excel module which runs through some calculations then sends an outlook e-mail. The e-mail, attaches some info to the body and displays, rather than sends, in order for the user to validate and the e-mail before sending. When logged in during the day, the module runs fine and does what it's supposed to do as all calculations are run and the e-mail pops up with the correct data; however, at night, the batch shows Excel ran all the calculations but the e-mail never pops up. So it's not interacting with Outlook when logged out. I'm on an Aruba system and have set up all the Windows settings to turn off display never, power & sleep turn off (never) and I don't log off at night (just switch my screen off) in hopes it doesn't log me out; however, in the morning, it has me log back in again. Is there anyway around the logoff that is happening or is there a way to force the module to communicate with outlook?

Here's the code that sends the e-mail:

VBA Code:
Sub Mail_Selection_Range_Outlook_Body4()
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Dim StrBody2 As String
Dim StrDate As String
txtdate = Format(Now, "mm") & "_" & Format(Now, "dd") & "_" & Format(Now, "yyyy")
strbody = "Link to file:" & vbCrLf & vbCrLf & "<a href=""[URL='https://sharepoint.abc.com/sites/Shared%20Documents/Report_']https://sharepoint.abc.com/sites/Shared Documents/Report_[/URL]" & txtdate & "%204pm.xlsx?Web=1"">FILE</a>"

Set rng = Nothing
On Error Resume Next
'You can also use a fixed range if you want
Set rng = ThisWorkbook.Sheets("Email").Range("A1:B16").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
Exit Sub
End If

With Application
    .EnableEvents = False
    .ScreenUpdating = False
End With

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

On Error Resume Next
With OutMail
    .Display
    .To = "Cag, Michelle <[EMAIL]Michelle.Cag@abc.com[/EMAIL]>"
    .CC = ""
    .BCC = ""
    .Subject = "4PM Report"
    .HTMLBody = strbody & RangetoHTML(rng) & .HTMLBody
    .Display   'or use .Send
End With
On Error GoTo 0

With Application
    .EnableEvents = True
    .ScreenUpdating = True
End With

    Set OutMail = Nothing
    Set OutApp = Nothing
Call SaveBucketsFile4
End Sub

Function RangetoHTML(rng As Range)

    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook

    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

    'Copy the range and create a new workbook to past the data in
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With

    'Publish the sheet to a htm file
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With

    'Read all data from the htm file into RangetoHTML
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.readall
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")

    'Close TempWB
    TempWB.Close savechanges:=False

    'Delete the htm file we used in this function
    Kill TempFile

    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function
 
Last edited by a moderator:

Some videos you may like

Excel Facts

Bring active cell back into view
Start at A1 and select to A9999 while writing a formula, you can't see A1 anymore. Press Ctrl+Backspace to bring active cell into view.

Anthony47

Well-known Member
Joined
Mar 29, 2006
Messages
1,972
Try adding some waits here and there:
Code:
Set OutApp = CreateObject("Outlook.Application")
Application.Wait (Now + TimeValue("0:00:02"))
Set OutMail = OutApp.CreateItem(0)
Application.Wait (Now + TimeValue("0:00:02"))
'''''' On Error Resume Next                           '<<< WHY IS (was) IT THERE?
With OutMail
    .Display
    .To = "Cag, Michelle <[EMAIL]Michelle.Cag@abc.com[/EMAIL]>"
    .CC = ""
    .BCC = ""
    .Subject = "4PM Report"
    .HTMLBody = strbody & RangetoHTML(Rng) & .HTMLBody
    .Display   'or use .Send
End With
'''''''On Error GoTo 0
Application.Wait (Now + TimeValue("0:00:01"))
With Application
    .EnableEvents = True
Also I removed that OnErrorResumeNext: you shouldn't expect any error in that section, and maybe you'll catch an error message that explains what is the problem

Bye
 

mssbass

Board Regular
Joined
Nov 14, 2002
Messages
235
Platform
  1. Windows
Try adding some waits here and there:
Code:
Set OutApp = CreateObject("Outlook.Application")
Application.Wait (Now + TimeValue("0:00:02"))
Set OutMail = OutApp.CreateItem(0)
Application.Wait (Now + TimeValue("0:00:02"))
'''''' On Error Resume Next                           '<<< WHY IS (was) IT THERE?
With OutMail
    .Display
    .To = "Cag, Michelle <[EMAIL]Michelle.Cag@abc.com[/EMAIL]>"
    .CC = ""
    .BCC = ""
    .Subject = "4PM Report"
    .HTMLBody = strbody & RangetoHTML(Rng) & .HTMLBody
    .Display   'or use .Send
End With
'''''''On Error GoTo 0
Application.Wait (Now + TimeValue("0:00:01"))
With Application
    .EnableEvents = True
Also I removed that OnErrorResumeNext: you shouldn't expect any error in that section, and maybe you'll catch an error message that explains what is the problem

Bye
Waits aren't the issue - it's not triggering the Outlook email at all.
 

Anthony47

Well-known Member
Joined
Mar 29, 2006
Messages
1,972
And, after removing On Error Resume Next, does the macro trigger any error?
 

daverunt

Well-known Member
Joined
Jul 9, 2009
Messages
1,887
Office Version
  1. 2013
Platform
  1. Windows

ADVERTISEMENT

Don't know what an Aruba system is based on?


In Windows 10 there is an additional settings in
Windows 10 Settings>Accounts>Sign-in Options, which requires the user log back in every x minutes after being away. This can be set to never.

Also can be accessed via Control Panel > User Accounts
Make changes to my account in PC Settings
Sign in Option - Never
 

mssbass

Board Regular
Joined
Nov 14, 2002
Messages
235
Platform
  1. Windows
Since I don't have admin rights, I'm going to put in a ticket to see if they can either give me rights to run the scheduled task with highest privileges or make changes to the user account's sign in options. Since we're a medical company, I doubt they will want the laptop permanently logged in though.
 

Anthony47

Well-known Member
Joined
Mar 29, 2006
Messages
1,972
Add Stop in this position:
Code:
Set OutMail = OutApp.CreateItem(0)
Stop
'next instructions
Remove any OnErrorResumeNext after the Sop

Then logout from Outlook
Use TaskManager, tab Processes, to check if you have any "Outlook" or "Microsoft Outlook" process (you shouldn't have one)

Then start the macro; it will halt on the "Stop" line
Check again in TaskManager if you have any "Outlook" or "Microsoft Outlook" process: you should now have one

If you have the Outlook process, use the key F8 to step through the code, one instruction each F8. Take note of what happens.
After you execute ".Display" then the email form should be visible
Try stepping till End Sub. In case you receive an error take a snapshot of the screen

Tell us what happens during this process
 

Watch MrExcel Video

Forum statistics

Threads
1,122,529
Messages
5,596,695
Members
414,088
Latest member
rodriboraun

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top