Running VBA code at a certain Time

[iheartvba]

Hi,
I am trying to run a VBA procedure to send an e-mail every day at 9:00 PM. How would this be achieved.

I'm not sure if this would help but the code is as follows

Option Compare Database
Option Explicit
Dim cnn As ADODB.Connection
Dim rst As New ADODB.Recordset
Public Sub XptHoRpt()
Dim strOfficeID As String
Dim strSqlMaxXptDt As String
Dim strSql As String
Dim strSubject As String
Dim dtStart As Date
Dim dtEnd As Date
Set cnn = Nothing
Set rst = Nothing
'cnn set to currentproject.connection throught sub then set to nothing at end and start
Set cnn = CurrentProject.Connection
strSqlMaxXptDt = "SELECT Max(tblExport.ExpDate) AS MaxOfExpDate " & _
                 "FROM tblExport;"
rst.Open strSqlMaxXptDt, cnn, adOpenDynamic, adLockOptimistic
    With rst
        dtStart = CDate(!MaxOfExpDate) - 1
    End With
Set rst = Nothing
        dtEnd = Date
'The End Date must be greater than the Start Date, if it isn't then exit routine
    If dtEnd < dtStart Then
    MsgBox "End Date Must be Greater Than Start Date"
    Exit Sub
    Else
    'start date and end date must be added by 1 and subtracted by 1 day respectivley as the
    'queries use these dates as filters they are used as follows:
    'Where Date (>cboStart and <tbEnd) so if the start date the user wants is 01/07/2007, the query
    'would need the date to be 02/07/2007 as 01/07/2007 is not greater than 01/07/2007
    End If
'tblSite contains all an offices specific details OfficeID is unique for each office
rst.Open "tblSite", cnn, adOpenDynamic, adLockOptimistic
    With rst
    Me.tbOfficeID = !OfficeID
    End With
Set rst = Nothing
'Checks whether client addresses for all receipts cut have been imported correctly
'Change'Currently filtered for only 2008 receipts
rst.Open "qryAddCheck", cnn, adOpenDynamic, adLockOptimistic
With rst
    'If there are addresses that haven't been imported then...
    If rst.EOF = False And rst.BOF = False Then
    'Display the TFN and Year of Job for related to the addresses, so they can be manually imported from HandiTax Program
    DoCmd.OpenQuery "qryAddCheck"
    'Prompts client to import addresses otherwise the Head Office Report won't be exported
    MsgBox "You can't export the report as all clients addresses are not in Access" & vbCrLf & "For each TFN listed on this report " & vbCrLf & "1. Tag the Client in HandiTax" & vbCrLf & "2. Export to Access" & vbCrLf & "3. Import all the addresses into Access " & vbCrLf & "4. Attempt to export the Head Office Report again"
    Exit Sub
    Else
    cboStartDate = dtStart - 2
    tbEndDate = dtEnd + 1
    'Else If all above checks have been cleared then export the Head Office Report so it can be e-mailed
    DoCmd.TransferText acExportDelim, , "qryXptTblClientDetailsIMP", "C:\HoXpt\qryXptTblClientDetailsIMP.txt", True
    DoCmd.TransferText acExportDelim, , "qryXptTblClientDetailsUPD", "C:\HoXpt\qryXptTblClientDetailsUPD.txt", True
    DoCmd.TransferText acExportDelim, , "qryXptTblCollectionsIMP", "C:\HoXpt\qryXptTblCollectionsIMP.txt", True
    DoCmd.TransferText acExportDelim, , "qryXptTblCollectionsUPD", "C:\HoXpt\qryXptTblCollectionsUPD.txt", True
    DoCmd.TransferText acExportDelim, , "qryXptTblFFRBankDetailsIMP", "C:\HoXpt\qryXptTblFFRBankDetailsIMP.txt", True
    DoCmd.TransferText acExportDelim, , "qryXptTblFFRBkChangeLogIMP", "C:\HoXpt\qryXptTblFFRBkChangeLogIMP.txt", True
    DoCmd.TransferText acExportDelim, , "qryXptTblFFRChangeLogIMP", "C:\HoXpt\qryXptTblFFRChangeLogIMP.txt", True
    DoCmd.TransferText acExportDelim, , "qryXptTblFFRIMP", "C:\HoXpt\qryXptTblFFRIMP.txt", True
    DoCmd.TransferText acExportDelim, , "qryXptTblJobDetailsIMP", "C:\HoXpt\qryXptTblJobDetailsIMP.txt", True
    DoCmd.TransferText acExportDelim, , "qryXptTblJobDetailsUPD", "C:\HoXpt\qryXptTblJobDetailsUPD.txt", True
    DoCmd.TransferText acExportDelim, , "qryXptTblJobPeriodsChangeLogIMP", "C:\HoXpt\qryXptTblJobPeriodsChangeLogIMP.txt", True
    DoCmd.TransferText acExportDelim, , "qryXptTblJobPeriodsIMP", "C:\HoXpt\qryXptTblJobPeriodsIMP.txt", True
    DoCmd.TransferText acExportDelim, , "qryXptTblPendingItemsIMP", "C:\HoXpt\qryXptTblPendingItemsIMP.txt", True
    DoCmd.TransferText acExportDelim, , "qryXptTblPendingsChangeLogIMP", "C:\HoXpt\qryXptTblPendingsChangeLogIMP.txt", True
    DoCmd.TransferText acExportDelim, , "qryXptTblTimeCardIMP", "C:\HoXpt\qryXptTblTimeCardIMP.txt", True
    DoCmd.TransferText acExportDelim, , "qryXptTblVoidIMP", "C:\HoXpt\qryXptTblVoidIMP.txt", True
    DoCmd.TransferText acExportDelim, , "qryXptTblYearsPerReceiptChangeLogIMP", "C:\HoXpt\qryXptTblYearsPerReceiptChangeLogIMP.txt", True
    DoCmd.TransferText acExportDelim, , "qryXptTblYearsPerReceiptIMP", "C:\HoXpt\qryXptTblYearsPerReceiptIMP.txt", True
    DoCmd.TransferText acExportDelim, , "qryXptTblChangeLogIMP", "C:\HoXpt\qryXptTblChangeLogIMP.txt", True
    DoCmd.TransferText acExportDelim, , "qryXptTblClientAddressesIMP", "C:\HoXpt\qryXptTblClientAddressesIMP.txt", True
    End If
End With
        Set cnn = Nothing
        Set rst = Nothing
Dim strEmail As String
Dim strMsg As String
Dim oLook As Object
Dim oMail As Object
Set oLook = CreateObject("Outlook.Application")
Set oMail = oLook.CreateItem(0)
strSubject = "Office #" & Me.tbOfficeID & " HO Report From " & dtStart & " To " & dtEnd
Me.tbSubject = strSubject
With oMail
'Email all exported HO Report files to Head Office E-mail
.To = "[e-mail]"
.Subject = strSubject
.attachments.Add ("C:\HoXpt\qryXptTblChangeLogIMP.txt")
.attachments.Add ("C:\HoXpt\qryXptTblClientAddressesIMP.txt")
.attachments.Add ("C:\HoXpt\qryXptTblClientDetailsIMP.txt")
.attachments.Add ("C:\HoXpt\qryXptTblClientDetailsUPD.txt")
.attachments.Add ("C:\HoXpt\qryXptTblCollectionsIMP.txt")
.attachments.Add ("C:\HoXpt\qryXptTblCollectionsUPD.txt")
.attachments.Add ("C:\HoXpt\qryXptTblFFRBankDetailsIMP.txt")
.attachments.Add ("C:\HoXpt\qryXptTblFFRBkChangeLogIMP.txt")
.attachments.Add ("C:\HoXpt\qryXptTblFFRChangeLogIMP.txt")
.attachments.Add ("C:\HoXpt\qryXptTblFFRIMP.txt")
.attachments.Add ("C:\HoXpt\qryXptTblJobDetailsIMP.txt")
.attachments.Add ("C:\HoXpt\qryXptTblJobDetailsUPD.txt")
.attachments.Add ("C:\HoXpt\qryXptTblJobPeriodsChangeLogIMP.txt")
.attachments.Add ("C:\HoXpt\qryXptTblJobPeriodsIMP.txt")
.attachments.Add ("C:\HoXpt\qryXptTblPendingItemsIMP.txt")
.attachments.Add ("C:\HoXpt\qryXptTblPendingsChangeLogIMP.txt")
.attachments.Add ("C:\HoXpt\qryXptTblTimeCardIMP.txt")
.attachments.Add ("C:\HoXpt\qryXptTblVoidIMP.txt")
.attachments.Add ("C:\HoXpt\qryXptTblYearsPerReceiptChangeLogIMP.txt")
.attachments.Add ("C:\HoXpt\qryXptTblYearsPerReceiptIMP.txt")
.Send
End With
Set oMail = Nothing
Set oLook = Nothing
End Sub
 

as always your help is greatly appreciated

[ADezii]

I haven't actually tested this, but:

1. Copy and Paste your code to a Public Function called fXptHoRpt.
2. Create a Macro named AutoExec that will execute this Function (RunCode()).
3. The next line of the AutoExec Macro will Quit the Macro, thus closing the Database.
4. Create a Scheduled Task on your PC to start at 9:00 P.M. every day. Assuming your Database is named Test.mdb and resides in the C:\Test Directory, the Command Line for this Task will be something similar to:
   

   "C:\Program Files\Microsoft Office\OFFICE11\MSACCESS.EXE" "C:\Test\Test.mdb"

5. At 9:00 P.M. every evening, the Task will execute, Test.mdb will be Opened, the AutoExec Macro will Run executing the fXptHoRpt() Function which will send the E-Mail/Attachments, then the Database will Close.
6. Again, this hasn't been tested, it exists only in Theory.

[Megalog]

I like ADezii's approach.

The alternative would be to have a hidden form, that has it's timer checking every minute to see what the current time is. If the time matches 9:00 pm, then it executes the macro. This requires the database always be up and running though.

[ADezii]

@Megalog

I like ADezii's approach.

Yea, but will it actually work? (LOL). My main concern here is that since the code will be running asynchronously, the Quit Macro Action may execute while the Function Code sending the E-Mail/Attachments has not yet completed. Interesting scenario, though. Some Delay Method, after the Function Call, but prior to the Quit Command, may actually do the trick.

[Megalog]

Does that command need to be in the autoexec though? Why cant the autoexec execute the function, and then have that function close the database when it's done (insert DoCmd.Quit right at the end)?

[ADezii]

@Megalog
Excellent point and well taken. Keep it encapsulated within the Function as opposed to a separate Statement, good idea Megalog.

[iheartvba]

Hi Guys,
I had actually tried Adezii's suggetion in Quote 2 of this Post, but instead of declaring a public function i had declared a public sub. So now it's working. There is only 1 difference in my approach. Instead of using autoexec I have just made a shortcut of the macro on a network drive and I get Winows Task Scheduler to Run the shortcut (it works).

Thanks Guys,

as always you are very helpfull

and your help is always appreciated

[ADezii]

@iheartvba
Glad you got it working, iheartvba, but kindly explain one thing to me? RunCode() when used in the context of a Macro will always accept a Function Name and never a Sub-Routine Name as its Argument. How exactly did you get this to work?

[iheartvba]

Hi ADezzi,
Actually that was the issue, it wasn't working when I had put the Sub-Routine name in the argument, then when I read your Quote 2 on this post I realized I had to go to the Module and change the Sub Routine to a Function. After I did that it worked.

[iheartvba]

<Duplicate Quote deleted>

[MaGo]

Please, can you explain how to make macro shortcut?
Sorry, but I' m trying only from few times to programm VBA.......
Many thanks.
MaGo

[iheartvba]

Hi MaGo,
There are probably many ways to do it. But I just drag and drop the Icon for the Relevant Macro to the desired location.

All the best

[MaGo]

Like Columbus egg....
Many thanks, especially for speedy answer, you are very kind.
MaGo