Auto-Schedule Macros to Run, vba send E-mail without Outlook error message, getting around Access queries with parameters

Thanks Thanks:  0
Likes Likes:  0
Results 1 to 3 of 3

Thread: Auto-Schedule Macros to Run, vba send E-mail without Outlook error message, getting around Access queries with parameters

  1. #1
    New Member
    Join Date
    Mar 2012
    Post Thanks / Like
    0 Post(s)
    0 Thread(s)

    Smile Auto-Schedule Macros to Run, vba send E-mail without Outlook error message, getting around Access queries with parameters

    Hi there,

    I just wanted to share some code on here that I have found, after spending several days trying to get around a few problems with some Excel macros I was running. Firstly, I wanted to set up a macro to query an Access database with parameters and import the results into an Excel file so that I could format and manipulate it. Then, I wanted to e-mail the data from the Excel file in the body of the e-mail. Finally, I wanted this process to run automatically every day at 9:00am (i.e. so the e-mail would go out even on the weekends etc.).

    The first problem I ran into was with the database query (getting around the parameter problem. Also, I did not have administrator access to the database).The 3 parameters were Start Date, End Date, and Store Code.
    The first thing I had to do was make sure that I had the following References checked (Visual Basic Editor -> Tools -> References...):
    1. Microsoft ActiveX Data Objects Recordset 2.8 Library
    2. Microsoft DAO 3.6 Object Library

    Then, I used the code below to import my query:

    Private Sub ImportQuery()
    Dim MyDatabase As DAO.Database
    Dim MyQueryDef As DAO.QueryDef
    Dim MyRecordset As DAO.Recordset
    Sheets("Query Result").Select
    Set MyDatabase = DBEngine.OpenDatabase("C:\MyDatabase.mdb")
    Set MyQueryDef = MyDatabase.QueryDefs("QueryName")
    With MyQueryDef
    .Parameters("[Date Start]") = Sheets("Set-Up").Range("C1").Value 
    .Parameters("[Date End]") = Sheets("Set-Up").Range("C2").Value
    .Parameters("[Store Code]") = Sheets("Set-Up").Range("C3").Value
    End With
    Set MyRecordset = MyQueryDef.OpenRecordset
    Sheets("Query Result").Select
    ActiveSheet.Range("A2").CopyFromRecordset MyRecordset
    End Sub
    The second problem I had was when I tried to send the e-mail using VBA, an annoying pop-up would appear in Outlook saying "A program is trying to automatically send e-mail on your behalf. Do you want to allow this?" Unless I clicked "yes", the e-mail would not be sent. After much research, I tried using CDO to try and get around this security feature in Outlook, but I had problems with that too (maybe because of firewalls or blocked ports?). So, my solution was to save the e-mail as a draft instead, using the code below:

    Private Sub SaveDraftEmail()
        Dim rng As Range
        Dim OutApp As Object
        Dim OutMail As Object
        Set rng = Sheets("E-mail").Range("A1:F19").SpecialCells(xlCellTypeVisible)
        With Application
            .EnableEvents = False
            .ScreenUpdating = False
        End With
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)
        On Error Resume Next
        With OutMail
            .To = Sheets("Set-Up").Range("B5").Value
            .From = ""
            .CC = Sheets("Set-Up").Range("B6").Value
            .BCC = ""
            .Subject = Sheets("Set-Up").Range("B8").Value
            .HTMLBody = RangetoHTML(rng)
        End With
        On Error GoTo 0
        With Application
            .EnableEvents = True
            .ScreenUpdating = True
        End With
        Set OutMail = Nothing
        Set OutApp = Nothing
    End Sub
    Function RangetoHTML(rng As Range)
    'This function converts the data in the Excel spreadsheet to HTML to put in the body of the e-mail
        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"
        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
            Application.CutCopyMode = False
            On Error Resume Next
            .DrawingObjects.Visible = True
            On Error GoTo 0
        End With
        With TempWB.PublishObjects.Add( _
             SourceType:=xlSourceRange, _
             Filename:=TempFile, _
             Sheet:=TempWB.Sheets(1).Name, _
             Source:=TempWB.Sheets(1).UsedRange.Address, _
            .Publish (True)
        End With
        Set fso = CreateObject("Scripting.FileSystemObject")
        Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
        RangetoHTML = ts.ReadAll
        RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                              "align=left x:publishsource=")
        TempWB.Close savechanges:=False
        Kill TempFile
        Set ts = Nothing
        Set fso = Nothing
        Set TempWB = Nothing
    End Function
    The following code is used to run the query, send it to e-mail drafts, and then save and close the workbook.

    Sub ImportAndEmail()
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With
    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With
    End Sub

    Finally, I wanted to schedule this process to occur at 9:00 am every day (and also send out the e-mail which I had saved as a draft!). First, I had to change the macro security in Outlook to allow macros to run (Tools -> Macro -> Security -> Low)

    I then entered the following code under "ThisOutlookSession" in Outlook Visual Basic Editor:

    Public Sub SendDrafts()
    Dim lDraftItem As Long
    Dim myOutlook As Outlook.Application
    Dim myNameSpace As Outlook.NameSpace
    Dim myFolders As Outlook.Folders
    Dim myDraftsFolder As Outlook.MAPIFolder
    Set myOutlook = Outlook.Application
    Set myNameSpace = myOutlook.GetNamespace("MAPI")
    Set myFolders = myNameSpace.Folders
    Set myDraftsFolder = myFolders("Mailbox - My Name").Folders("Drafts")
    For lDraftItem = myDraftsFolder.Items.Count To 1 Step -1
    If myDraftsFolder.Items.Item(lDraftItem).Subject Like "My Daily E-mail for*" Then
    End If
    Next lDraftItem
    Set myDraftsFolder = Nothing
    Set myNameSpace = Nothing
    Set myOutlook = Nothing
    End Sub
    Then, I used Scheduler (Control Panel -> Scheduled Tasks) to run the following code at 9:00 am each day:

    Set xl = CreateObject("Excel.application")
    xl.Application.Workbooks.Open "C:\My sample.xls"
    xl.Application.Visible = True "'My sample.xls'!Module1.ImportAndEmail"
    Set xl = Nothing
    Set app = CreateObject("Outlook.application")
    Call app.SendDrafts
    *This was my first time using scheduler and vbscript, so for other first-timers: I pasted the code above into notepad and saved it as "RunDaily.vbs" (make sure it doesn't have .txt on the end of the name). Then in Scheduled Tasks (in your Control Panel), go to "Add Scheduled Tasks", Browse for your .vbs file, and enter your scheduling options.

    I am fairly new to VBA but it has helped me a TON in speeding up some of my daily work activities. I'm excited to start using some new tools (scheduler, VBscript etc.) now. I hope that these examples help other newbies too, because I spent a lot of time trying to find simple solutions to these problems! If anyone has any additional input on how I could improve this process, I'd love to hear it too!

    I am using Microsoft Office 2003.



    I cannot remember where I got the original code for the Access Query (I think it was here:
    This is where I got the code for Outlook:

  2. #2
    Board Regular Trevor G's Avatar
    Join Date
    Jul 2008
    Tamworth, Staffordshire
    Post Thanks / Like
    0 Post(s)
    0 Thread(s)

    Default Re: Auto-Schedule Macros to Run, vba send E-mail without Outlook error message, getting around Access queries with parameters

    Welcome to the Forum Stacey,

    You obviously have spent a lot of time working this out and to actually post VBA and a solution for your first thread is very commendable.

    To get around the Outlook message you can use a third party software this link provides the download.
    I am on a learning curve of life, I know a little but like to share what I have learnt with others.
    I am using Microsoft Office 2003 to 2016
    Please remember everyone here is a volunteer, so if you have had a reply to your thread be courteous and acknowledge this.

  3. #3
    Board Regular
    Join Date
    Dec 2005
    Basingstoke (UK)
    Post Thanks / Like
    0 Post(s)
    0 Thread(s)

    Default Re: Auto-Schedule Macros to Run, vba send E-mail without Outlook error message, getting around Access queries with parameters

    Hello and welcome to The Board.
    This is a good post and I am sure it will be useful to others (I will make a note of it to pass on to others should the need arise).
    I have used a similar process for the management of my fully-automated Data Warehouse system. That is controlled using VB code (not VBA) and Task Scheduler together with Outlook code. The system runs on a dedicated server with Windows Server 2008 R2 and Office 2007 (previously ran on dedicated PC running XP and Office 2003).
    Some recommendations:
    1. Avoid setting macro security too Low. Using a Self-signed Certificate should allow you to set it higher.
    With this I could send the email directly from Excel, instead of saving etc., on the XP/2003 system. However, I found that on the Windows Server/Office 2007 system other security settings made that difficult so implemented a save/send process similar to yours.
    See also:
    2. When running from VB/Task Scheduler, it is important to make sure that all objects are released at the end to avoid the other application (e.g. Excel) remaining in memory until the PC/Server was restarted or the application abandoned from Task Manager. Here is an example of the code that I currently use:
    Imports System.IO
    Module Module1
    Public Sub Main()
    End Sub
    Sub RunMyWorkbook()
    Const strControlFileName As String = "P:\MyFolder\MyWorkbook.xlsm"
    Dim oExcel As Microsoft.Office.Interop.Excel.Application
    Dim oBook As Microsoft.Office.Interop.Excel.Workbook
    Dim oBooks As Microsoft.Office.Interop.Excel.Workbooks
    Dim strFilenameCheck As String
    Dim strMacroName As String
    strMacroName = "RunMyWorkbook"
    oExcel = CType(CreateObject("Excel.Application"), Microsoft.Office.Interop.Excel.Application)
    oExcel.Visible = False
    oBooks = CType(oExcel.Workbooks(), Microsoft.Office.Interop.Excel.Workbooks)
    strFilenameCheck = Dir(strControlFileName)
    If strFilenameCheck <> "" Then
    oBook = CType(oBooks.Open(strControlFileName), Microsoft.Office.Interop.Excel.Workbook)
    oExcel.DisplayAlerts = False
    oExcel.DisplayAlerts = True
    Dim sw As New StreamWriter(Application.StartupPath & "\MyWorkbook_error.log", True)
    sw.WriteLine(Now() & " - '" & strControlFileName & "' could not be accessed.")
    End If
    Catch ex As Exception
    Dim sw As New StreamWriter(Application.StartupPath & "\MyWorkbook_Error.log", True)
    sw.WriteLine(Now() & " - " & ex.Message)
    oBook = Nothing
    oBooks = Nothing
    oExcel = Nothing
    End Try
    End Sub
    End Module
    Note the use of Garbage Collector (GC) at the end of the code.
    3. You may find useful
    Never give way to anger - otherwise in one day you could burn up the wood that you collected in many bitter weeks.

User Tag List

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts