By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
435,301 Members | 1,752 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 435,301 IT Pros & Developers. It's quick & easy.

Running VBA code at a certain Time

100+
P: 171
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
Expand|Select|Wrap|Line Numbers
  1. Option Compare Database
  2. Option Explicit
  3. Dim cnn As ADODB.Connection
  4. Dim rst As New ADODB.Recordset
  5. Public Sub XptHoRpt()
  6. Dim strOfficeID As String
  7. Dim strSqlMaxXptDt As String
  8. Dim strSql As String
  9. Dim strSubject As String
  10. Dim dtStart As Date
  11. Dim dtEnd As Date
  12. Set cnn = Nothing
  13. Set rst = Nothing
  14. 'cnn set to currentproject.connection throught sub then set to nothing at end and start
  15. Set cnn = CurrentProject.Connection
  16. strSqlMaxXptDt = "SELECT Max(tblExport.ExpDate) AS MaxOfExpDate " & _
  17.                  "FROM tblExport;"
  18. rst.Open strSqlMaxXptDt, cnn, adOpenDynamic, adLockOptimistic
  19.     With rst
  20.         dtStart = CDate(!MaxOfExpDate) - 1
  21.     End With
  22. Set rst = Nothing
  23.         dtEnd = Date
  24. 'The End Date must be greater than the Start Date, if it isn't then exit routine
  25.     If dtEnd < dtStart Then
  26.     MsgBox "End Date Must be Greater Than Start Date"
  27.     Exit Sub
  28.     Else
  29.     'start date and end date must be added by 1 and subtracted by 1 day respectivley as the
  30.     'queries use these dates as filters they are used as follows:
  31.     'Where Date (>cboStart and <tbEnd) so if the start date the user wants is 01/07/2007, the query
  32.     'would need the date to be 02/07/2007 as 01/07/2007 is not greater than 01/07/2007
  33.     End If
  34. 'tblSite contains all an offices specific details OfficeID is unique for each office
  35. rst.Open "tblSite", cnn, adOpenDynamic, adLockOptimistic
  36.     With rst
  37.     Me.tbOfficeID = !OfficeID
  38.     End With
  39. Set rst = Nothing
  40. 'Checks whether client addresses for all receipts cut have been imported correctly
  41. 'Change'Currently filtered for only 2008 receipts
  42. rst.Open "qryAddCheck", cnn, adOpenDynamic, adLockOptimistic
  43. With rst
  44.     'If there are addresses that haven't been imported then...
  45.     If rst.EOF = False And rst.BOF = False Then
  46.     'Display the TFN and Year of Job for related to the addresses, so they can be manually imported from HandiTax Program
  47.     DoCmd.OpenQuery "qryAddCheck"
  48.     'Prompts client to import addresses otherwise the Head Office Report won't be exported
  49.     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"
  50.     Exit Sub
  51.     Else
  52.     cboStartDate = dtStart - 2
  53.     tbEndDate = dtEnd + 1
  54.     'Else If all above checks have been cleared then export the Head Office Report so it can be e-mailed
  55.     DoCmd.TransferText acExportDelim, , "qryXptTblClientDetailsIMP", "C:\HoXpt\qryXptTblClientDetailsIMP.txt", True
  56.     DoCmd.TransferText acExportDelim, , "qryXptTblClientDetailsUPD", "C:\HoXpt\qryXptTblClientDetailsUPD.txt", True
  57.     DoCmd.TransferText acExportDelim, , "qryXptTblCollectionsIMP", "C:\HoXpt\qryXptTblCollectionsIMP.txt", True
  58.     DoCmd.TransferText acExportDelim, , "qryXptTblCollectionsUPD", "C:\HoXpt\qryXptTblCollectionsUPD.txt", True
  59.     DoCmd.TransferText acExportDelim, , "qryXptTblFFRBankDetailsIMP", "C:\HoXpt\qryXptTblFFRBankDetailsIMP.txt", True
  60.     DoCmd.TransferText acExportDelim, , "qryXptTblFFRBkChangeLogIMP", "C:\HoXpt\qryXptTblFFRBkChangeLogIMP.txt", True
  61.     DoCmd.TransferText acExportDelim, , "qryXptTblFFRChangeLogIMP", "C:\HoXpt\qryXptTblFFRChangeLogIMP.txt", True
  62.     DoCmd.TransferText acExportDelim, , "qryXptTblFFRIMP", "C:\HoXpt\qryXptTblFFRIMP.txt", True
  63.     DoCmd.TransferText acExportDelim, , "qryXptTblJobDetailsIMP", "C:\HoXpt\qryXptTblJobDetailsIMP.txt", True
  64.     DoCmd.TransferText acExportDelim, , "qryXptTblJobDetailsUPD", "C:\HoXpt\qryXptTblJobDetailsUPD.txt", True
  65.     DoCmd.TransferText acExportDelim, , "qryXptTblJobPeriodsChangeLogIMP", "C:\HoXpt\qryXptTblJobPeriodsChangeLogIMP.txt", True
  66.     DoCmd.TransferText acExportDelim, , "qryXptTblJobPeriodsIMP", "C:\HoXpt\qryXptTblJobPeriodsIMP.txt", True
  67.     DoCmd.TransferText acExportDelim, , "qryXptTblPendingItemsIMP", "C:\HoXpt\qryXptTblPendingItemsIMP.txt", True
  68.     DoCmd.TransferText acExportDelim, , "qryXptTblPendingsChangeLogIMP", "C:\HoXpt\qryXptTblPendingsChangeLogIMP.txt", True
  69.     DoCmd.TransferText acExportDelim, , "qryXptTblTimeCardIMP", "C:\HoXpt\qryXptTblTimeCardIMP.txt", True
  70.     DoCmd.TransferText acExportDelim, , "qryXptTblVoidIMP", "C:\HoXpt\qryXptTblVoidIMP.txt", True
  71.     DoCmd.TransferText acExportDelim, , "qryXptTblYearsPerReceiptChangeLogIMP", "C:\HoXpt\qryXptTblYearsPerReceiptChangeLogIMP.txt", True
  72.     DoCmd.TransferText acExportDelim, , "qryXptTblYearsPerReceiptIMP", "C:\HoXpt\qryXptTblYearsPerReceiptIMP.txt", True
  73.     DoCmd.TransferText acExportDelim, , "qryXptTblChangeLogIMP", "C:\HoXpt\qryXptTblChangeLogIMP.txt", True
  74.     DoCmd.TransferText acExportDelim, , "qryXptTblClientAddressesIMP", "C:\HoXpt\qryXptTblClientAddressesIMP.txt", True
  75.     End If
  76. End With
  77.         Set cnn = Nothing
  78.         Set rst = Nothing
  79. Dim strEmail As String
  80. Dim strMsg As String
  81. Dim oLook As Object
  82. Dim oMail As Object
  83. Set oLook = CreateObject("Outlook.Application")
  84. Set oMail = oLook.CreateItem(0)
  85. strSubject = "Office #" & Me.tbOfficeID & " HO Report From " & dtStart & " To " & dtEnd
  86. Me.tbSubject = strSubject
  87. With oMail
  88. 'Email all exported HO Report files to Head Office E-mail
  89. .To = "mas@itpnb.com.au"
  90. .Subject = strSubject
  91. .attachments.Add ("C:\HoXpt\qryXptTblChangeLogIMP.txt")
  92. .attachments.Add ("C:\HoXpt\qryXptTblClientAddressesIMP.txt")
  93. .attachments.Add ("C:\HoXpt\qryXptTblClientDetailsIMP.txt")
  94. .attachments.Add ("C:\HoXpt\qryXptTblClientDetailsUPD.txt")
  95. .attachments.Add ("C:\HoXpt\qryXptTblCollectionsIMP.txt")
  96. .attachments.Add ("C:\HoXpt\qryXptTblCollectionsUPD.txt")
  97. .attachments.Add ("C:\HoXpt\qryXptTblFFRBankDetailsIMP.txt")
  98. .attachments.Add ("C:\HoXpt\qryXptTblFFRBkChangeLogIMP.txt")
  99. .attachments.Add ("C:\HoXpt\qryXptTblFFRChangeLogIMP.txt")
  100. .attachments.Add ("C:\HoXpt\qryXptTblFFRIMP.txt")
  101. .attachments.Add ("C:\HoXpt\qryXptTblJobDetailsIMP.txt")
  102. .attachments.Add ("C:\HoXpt\qryXptTblJobDetailsUPD.txt")
  103. .attachments.Add ("C:\HoXpt\qryXptTblJobPeriodsChangeLogIMP.txt")
  104. .attachments.Add ("C:\HoXpt\qryXptTblJobPeriodsIMP.txt")
  105. .attachments.Add ("C:\HoXpt\qryXptTblPendingItemsIMP.txt")
  106. .attachments.Add ("C:\HoXpt\qryXptTblPendingsChangeLogIMP.txt")
  107. .attachments.Add ("C:\HoXpt\qryXptTblTimeCardIMP.txt")
  108. .attachments.Add ("C:\HoXpt\qryXptTblVoidIMP.txt")
  109. .attachments.Add ("C:\HoXpt\qryXptTblYearsPerReceiptChangeLogIMP.txt")
  110. .attachments.Add ("C:\HoXpt\qryXptTblYearsPerReceiptIMP.txt")
  111. .Send
  112. End With
  113. Set oMail = Nothing
  114. Set oLook = Nothing
  115. End Sub
  116.  
as always your help is greatly appreciated
Aug 24 '09 #1

✓ answered by 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:
    Expand|Select|Wrap|Line Numbers
    1. "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.

Share this Question
Share on Google+
12 Replies


ADezii
Expert 5K+
P: 8,638
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:
    Expand|Select|Wrap|Line Numbers
    1. "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.
Aug 24 '09 #2

Megalog
Expert 100+
P: 378
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.
Aug 24 '09 #3

ADezii
Expert 5K+
P: 8,638
@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.
Aug 24 '09 #4

Megalog
Expert 100+
P: 378
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)?
Aug 24 '09 #5

ADezii
Expert 5K+
P: 8,638
@Megalog
Excellent point and well taken. Keep it encapsulated within the Function as opposed to a separate Statement, good idea Megalog.
Aug 24 '09 #6

100+
P: 171
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
Aug 24 '09 #7

ADezii
Expert 5K+
P: 8,638
@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?
Aug 24 '09 #8

100+
P: 171
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.
Aug 25 '09 #9

100+
P: 171
<Duplicate Quote deleted>
Aug 25 '09 #10

P: 2
Please, can you explain how to make macro shortcut?
Sorry, but I' m trying only from few times to programm VBA.......
Many thanks.
MaGo
Oct 5 '09 #11

100+
P: 171
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
Oct 5 '09 #12

P: 2
Like Columbus egg....
Many thanks, especially for speedy answer, you are very kind.
MaGo
Oct 5 '09 #13

Post your reply

Sign in to post your reply or Sign up for a free account.