Send email while logged off with VBA, batch file, or scheduled task

Posted on 2011-05-04
Last Modified: 2012-05-11

I have a scheduled task to open an excel file.  This file has a macro which runs on open.
The macro updates the Excel file with some data, and creates and sends an email of the output.

This work fine while logged on, but if the scheduled task runs when I am logged off it hangs when the macro tries to open Outlook.  When I come back to the PC the task is still running in the background.  I've tested it without the email portion, and it works fine when logged off.

Could someone help me get this macro to work, or perhaps assist with an alternative?  I was thinking there may be a way to get Excel to save an HTML version of the email, then set another scheduled task, or call a batch file to send the email out as a second step.

I have posted both the Excel macro and the portion that creates the email separately.

Thank you.
Option Explicit
Const CdoPR_ATTACH_MIME_TAG As Long = &H370E001E
Const olSave = 0

Sub Bitmap_to_email()

'// Dimension variables using Latebinding
Dim oOutlookApp As Object
Dim oOutlookMessage As Object
Dim oFSObj As Object
Dim strHTMLBody As String
Dim strTempFilePath_a As String
Dim strTempFilePath_b As String
Dim strTempFilePath_c As String
Dim oOutlookAppAttach As Object
Dim oOutlook_Att As Object
Dim strEntryID As String
Dim oSession As Object
Dim summary1 As String
Dim summary2 As String
Dim summary3 As String
Dim summary4 As String
Dim summary5 As String
Dim summary6 As String

'// Use late binding    'Reference CDO
Dim oMsg As Object      'MAPI.Message
Dim oAttachs As Object  'MAPI.Attachments
Dim oAttach_a As Object   'MAPI.Attachment
Dim oAttach_b As Object   'MAPI.Attachment
Dim oAttach_c As Object   'MAPI.Attachment
Dim colFields_a As Object 'MAPI.Fields
Dim colFields_b As Object 'MAPI.Fields
Dim colFields_c As Object 'MAPI.Fields
Dim oField_a As Object    'MAPI.Field
Dim oField_b As Object    'MAPI.Field
Dim oField_c As Object    'MAPI.Field

'// Sheet
Dim objPict As Object
Dim MyChart_a As Chart
Dim MyChart_b As Chart
Dim MyChart_c As Chart
Dim rgImgSend As Range

summary1 = Range("B21")
summary2 = Range("B22")
summary3 = Range("B23")
summary4 = Range("B24")
summary5 = Range("B25")
summary6 = Range("B26")
'// Select the range to be sent
Set rgImgSend = Worksheets("report").Range("B2:AG19")

'// Set Range as an Image!
rgImgSend.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
ActiveSheet.PasteSpecial Format:="Bitmap", Link:=False, DisplayAsIcon:=False

Set objPict = Selection

'// Get the Temp folder path
Set oFSObj = CreateObject("Scripting.FilesystemObject")

strTempFilePath_a = oFSObj.GetSpecialFolder(2) & "\MyImg_a.gif"

With objPict
    Set MyChart_a = ActiveSheet.ChartObjects.Add(1, 1, .Width, .Height).Chart
End With

'// Export the chart. We'll use it later
With MyChart_a
    .Export strTempFilePath_a
End With

'*********************** same thing again for the 2nd range

'// Select the range to be sent
Set rgImgSend = Worksheets("report").Range("AL2:AV19")

'// Set Range as an Image!
rgImgSend.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
ActiveSheet.PasteSpecial Format:="Bitmap", Link:=False, DisplayAsIcon:=False
Set objPict = Selection

'// Get the Temp folder path
Set oFSObj = CreateObject("Scripting.FilesystemObject")

strTempFilePath_b = oFSObj.GetSpecialFolder(2) & "\MyImg_b.gif"
With objPict
    Set MyChart_b = ActiveSheet.ChartObjects.Add(1, 1, .Width, .Height).Chart
End With

'// Export the chart. We'll use it later
With MyChart_b
    .Export strTempFilePath_b
End With

'*********************** now for the chart

'// Select the range to be sent
Set rgImgSend = Worksheets("graphs").Range("B2:N17")

'// Set Range as an Image!
rgImgSend.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
ActiveSheet.PasteSpecial Format:="Bitmap", Link:=False, DisplayAsIcon:=False
Set objPict = Selection

'// Get the Temp folder path
Set oFSObj = CreateObject("Scripting.FilesystemObject")

strTempFilePath_c = oFSObj.GetSpecialFolder(2) & "\MyImg_c.gif"
With objPict
    Set MyChart_c = ActiveSheet.ChartObjects.Add(1, 1, .Width, .Height).Chart
End With

'// Export the chart. We'll use it later
With MyChart_c
    .Export strTempFilePath_c
End With

'// Create an instance of Outlook (or use existing instance if it already exists)
On Error Resume Next
Set oOutlookApp = GetObject(, "Outlook.Application")

If Err.Number <> 0 Then
    Set oOutlookApp = CreateObject("Outlook.Application")
    // We need the Application Open in order to NOT show as attachment
    Shell oOutlookApp, vbMaximizedFocus

******I think the above line is where it hangs*****
The rest of the macro does not run while logged off

'// Create a mail item
Set oOutlookMessage = oOutlookApp.CreateItem(0)
Set oOutlookAppAttach = oOutlookMessage.Attachments
'// add graphic as attachment to Outlook message
'// change path to graphic as needed
Set oOutlook_Att = oOutlookAppAttach.Add(strTempFilePath_a)
Set oOutlook_Att = oOutlookAppAttach.Add(strTempFilePath_b)
Set oOutlook_Att = oOutlookAppAttach.Add(strTempFilePath_c)

'// Lets save the msg, this is so that the EntryID property
'// is set.
oOutlookMessage.Close olSave

'// Lets get the unique entry ID of the object.
'// EntryID property corresponds to the MAPI property PR_ENTRYID.
'// MAPI systems assign a permanent, unique ID string when an object
'// is created that does not change from one MAPI session to another.
'// Also, the EntryID changes when an item is moved into another folder.
strEntryID = oOutlookMessage.EntryID

Set oOutlookMessage = Nothing
' *** POSITION CRITICAL *** you must dereference the
' attachment objects before changing their properties
' via CDO
Set oOutlookAppAttach = Nothing

'// initialize CDO session
On Error Resume Next
Set oSession = CreateObject("MAPI.Session")
oSession.Logon "", "", False, False
'// get the message created earlier
Set oMsg = oSession.GetMessage(strEntryID)

'// set properties of the attached graphic that make
'// it embedded and give it an ID for use in an <IMG> tag
Set oAttachs = oMsg.Attachments
Set oAttach_a = oAttachs.Item(1)
Set oAttach_b = oAttachs.Item(2)
Set oAttach_c = oAttachs.Item(3)
Set colFields_a = oAttach_a.Fields
Set colFields_b = oAttach_b.Fields
Set colFields_c = oAttach_c.Fields

'// Set oField_a = oFieldsColl.Add (name, Class [, value] [, PropsetID] )
Set oField_a = colFields_a.Add(CdoPR_ATTACH_MIME_TAG, "image/gif_a")
Set oField_a = colFields_a.Add(&H3712001E, "MyIdent_a")

'// Set oField_b = oFieldsColl.Add (name, Class [, value] [, PropsetID] )
Set oField_b = colFields_b.Add(CdoPR_ATTACH_MIME_TAG, "image/gif_b")
Set oField_b = colFields_b.Add(&H3712001E, "MyIdent_b")

'// Set oField_c = oFieldsColl.Add (name, Class [, value] [, PropsetID] )
Set oField_c = colFields_c.Add(CdoPR_ATTACH_MIME_TAG, "image/gif_c")
Set oField_c = colFields_c.Add(&H3712001E, "MyIdent_c")

oMsg.Fields.Add "{0820060000000000C000000000000046}0x8514", 11, True

'// Here put any HTML you want - this is just an example

strHTMLBody = strHTMLBody & "<span style='color:#1F497D'><p class=MsoNormal>Good Morning, <span style='color:#1F497D'><o:p></o:p></span></p>"
strHTMLBody = strHTMLBody & "<IMG align=baseline border=0 hspace=0 SRC=cid:MyIdent_a><br><br>"
strHTMLBody = strHTMLBody & "<IMG align=baseline border=0 hspace=0 SRC=cid:MyIdent_b><br><br>"
strHTMLBody = strHTMLBody & "<span style='color:#1F497D'>"
strHTMLBody = strHTMLBody & summary1 & "<br>"
strHTMLBody = strHTMLBody & summary2 & "<br>"
strHTMLBody = strHTMLBody & summary3 & "<br>"
strHTMLBody = strHTMLBody & summary4 & "<br>"
strHTMLBody = strHTMLBody & summary5 & "<br><br>"
strHTMLBody = strHTMLBody & "<IMG align=baseline border=0 hspace=0 SRC=cid:MyIdent_c><br><br>"

'// Get the Outlook MailItem again
Set oOutlookMessage = oOutlookApp.GetNamespace("MAPI").GetItemFromID(strEntryID)

'// add HTML content -- the <IMG> tag
With oOutlookMessage
    .To = ""
    .HTMLBody = strHTMLBody
    .Subject = "Report for " & Format(Now(), "MMM, D, YYYY")
    .Close (olSave)
End With

'// cleanup
Set oFSObj = Nothing
Set oField_a = Nothing
Set oField_b = Nothing
Set oField_c = Nothing
Set colFields_a = Nothing
Set colFields_b = Nothing
Set colFields_c = Nothing
Set oMsg = Nothing
Set oAttachs = Nothing
Set oAttach_a = Nothing
Set oAttach_b = Nothing
Set oAttach_c = Nothing
Set colFields_a = Nothing
Set colFields_b = Nothing
Set colFields_c = Nothing


Set oSession = Nothing
Set oOutlookApp = Nothing
Set oOutlookMessage = Nothing

Kill strTempFilePath_a
Kill strTempFilePath_b
Kill strTempFilePath_c

End Sub

Open in new window

Private Sub Workbook_Open()

'refreshes the data and pivot tables

ActiveSheet.Cells.EntireRow.Hidden = False
    ActiveCell.Offset(1, 0).Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.EntireRow.Hidden = True

'Saves the file - any work past this point will be copied over to the daily\weekly\monthly file
'and should not be saved to the template

'Hardcodes the data
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 'sends the email
Application.Run "'Daily Template.xlsm'!Bitmap_to_email"
'renames the tab
Dim daynum
daynum = Day(Now())
Worksheets("report").Name = daynum

'finds the monthly report workbook
Dim monthnum
If Month(Now()) < 10 Then monthnum = "0" & Month(Now()) Else monthnum = Month(Now())
    Workbooks.Open Filename:= _
        "C:\Daily\Daily 2011_" & monthnum & ".xlsx"
'copies the tab
    Sheets("" & daynum).Copy After:=Workbooks("Daily 2011_" & monthnum & ".xlsx"). _
        Sheets(Workbooks("Daily 2011_" & monthnum & ".xlsx").Worksheets.Count)
'saves and closes the monthly file
Application.DisplayAlerts = False
Application.Workbooks("Daily 2011_" & monthnum & ".xlsx").RefreshAll
Application.Workbooks("Daily 2011_" & monthnum & ".xlsx").Save
Application.Workbooks("Daliy 2011_" & monthnum & ".xlsx").Close

'closes the template(without saving - b/c we hardcoded the data)
'closes Excel

End Sub

The above code works great when logged off, with the exception of the bitmap to email macro call

Open in new window

Question by:TelMaco
    LVL 9

    Expert Comment

    Outlook 2007 should start into "offline" mode by default, if it is not connected.  But this does not seem to be happening for some reason in your case.

    Use a condition to check if you are already logged in ... something like the presence of a file on the network, or a ping test or something.

    If you are connected, then run the routine to send the email ... else, save the email, or do something else.

    Another option is to not use Outlook.  Use some VB/SMTP add-on and use that to send emails using an external account like Yahoo / GMail.


    Author Comment

    It's not exaclty the same as being logged in.  If I am manually logged in, this works 100%.  Is there a way to set a scheduled task to log myself in?  That would work too,

    It's connecting to my network with my creditials for sure.  If I take out the Outlook portion of the code, it work no problem.  Even while logged off.

    There is actually more to it where it moves the Excel file to an LAN folder, confirming that I'm connected ok.

    I can't even save the email.  The code hangs here:

        Set oOutlookApp = CreateObject("Outlook.Application")
        Shell oOutlookApp, vbMaximizedFocus

    Which is before the email is even created, so there is nothing to save.

    I'll have to use my Outlook account, external accounts will not be an option for me.


    Author Comment

    I have good news,

    I tested this while the PC was logged on and locked.  It works perfectly.

    So the only problem is when I'm fully logged off.  I can leave the PC on and locked, but there are some automatic updates which can force my PC to restart overnight.

    If I could set a rule on the PC to that would auto login on restart this would work.  Thoughts?

    LVL 10

    Accepted Solution

    Try this batch file.

    You can download the "blat" email command line utility here:

    Dont forget to customize the variables as needed.


    SET Emailer=blat.exe
    SET EmailSubject=TESTING
    SET EmailBody=THIS IS A TEST
    "%Emailer%" -body "%EmailBody%" -to "%EmailTo%" -f "%EmailFrom%" -s "%EmailSubject% %time%" -server "%EmailServer%" -debug -timestamp -log "Email.log" >NUL

    Open in new window


    Author Comment

    I can't get this to work:  SET

    I'm getting the server name from Outlook->Tools->Account Settings -> Change:
    It shows the Microsoft Exchange Server name there as:
    Nothing i try gets a response from that server though...

    This is from within a corp environment & I guess it's blocked somehow.  I just can't get the server to respond.

    I think I'm giving up on this one...I did find a workaround (sort of).  
    I have set Outlook to open when Windows starts, so it's always running.  
    I have a macro in Outlook that will send me an email when Outlook shutsdown.
    Since Outlook will only shutdown if the PC is restarting / turned off - I at least get an email to my phone that lets me know things were shutdown, and that I'll have to log it back in once it boots up.

    Thanks for the suggestions though.

    I'm pretty sure ReneGe's suggestion would work if I could actually connect to the server.  There are a number of similar approaches floating around on the 'net that seem to have worked for others, I think it;s just the corporate security settings that are stopping it from working for me.
    LVL 10

    Expert Comment

    Well actually, you could most likely send it directly to your ISP SMTP server, unless you have a blocking firewall rule.

    Author Comment

    I got it working, thank you.

    once Blat was installed to:

    I had to open cmd prompt and do this:

    Blat -Install
    I then tried to run the batch file you suggested but got an error msg:
    "Failed to open registry key for Blat profile..."

    So I did this:
    Blat -Install mailhost

    and tried the batch file again - it worked!

    Thank you
    LVL 10

    Expert Comment

    Happy I could help, and thanks for sharing your solution.


    Write Comment

    Please enter a first name

    Please enter a last name

    We will never share this with anyone.

    Featured Post

    Looking for New Ways to Advertise?

    Engage with tech pros in our community with native advertising, as a Vendor Expert, and more.

    Suggested Solutions

    Set OWA language and time zone in Exchange for individuals, all users or per database.
    Not sure what the best email signature size is? Are you worried about email signature image size? Follow this best practice guide.
    Viewers will learn how to properly install Eclipse with the necessary JDK, and will take a look at an introductory Java program. Download Eclipse installation zip file: Extract files from zip file: Download and install JDK 8: Open Eclipse and …
    To add imagery to an HTML email signature, you have two options available to you. You can either add a logo/image by embedding it directly into the signature or hosting it externally and linking to it. The vast majority of email clients display l…

    779 members asked questions and received personalized solutions in the past 7 days.

    Join the community of 500,000 technology professionals and ask your questions.

    Join & Ask a Question

    Need Help in Real-Time?

    Connect with top rated Experts

    14 Experts available now in Live!

    Get 1:1 Help Now