How do I get Outlook to periodically check a folder for files then email them out?

Question

Here is the proposed situation that I've been tasked with making work:

Monitor an email inbox
An email will arrive with attachment "thing.foo"
We want to be able to strip the attachment and save to a folder on the network
This will auto process through a system monitoring the folder
We then want to be able to pickup an output file and return this to the sender of the original email where the .foo came from (lets assume this is always the same address and fixed)

OK so I'm fine up to the last point:

I will use a small VBA script in an instance of Outlook on a sever to pull out the thing.foo file, give it a unique file name (uniqueThing.foo), and drop it in the network folder. The process (which is nothing to do with me) will run its course and save out as something like "uniqueThing_processed.foo" (maybe move the original to an archive folder)... I'm ok to this point.

Now, what I need to do is to get this instance of Outlook to check periodically (say every 5 minutes) for a "********_processed.foo" file, attach that to an email and send it (then maybe move the file to the archive and append "_sent")

Use a Timer, there is not one built in but you can call out to the API: https://stackoverflow.com/questions/12257985/outlook-vba-run-a-code-every-half-an-hour or as an alternative you could create a Reminder and hook into its reminder event. — Alex K., Jun 20 '17 at 10:16
Could you not write the whole thing in Outlook VBA? Write some code that does everything you want, make sure the code is passed the `MailItem` in it's arguments and you can set an Outlook rule to run that script when certain emails arrive. https://support.microsoft.com/en-gb/help/306108/how-to-create-a-script-for-the-rules-wizard-in-outlook — Darren Bartrup-Cook, Jul 31 '17 at 13:27
Yes, infact I did, but only for the incoming mail. the send-back needs to run every minute, not just when an email arrives in. — Digital Lightcraft, Jul 31 '17 at 13:29

score 1 · Accepted Answer · answered Jul 31 '17 at 13:19

As Alex K. stated, use a timer: Add to "ThisOutlookSession" the folowing

Private Sub Application_Quit()
If TimerID <> 0 Then Call EndTimer 'Turn off timer upon quitting **VERY IMPORTANT**
End Sub

Private Sub Application_Startup()
'MsgBox "Activating the Timer."
Call StartTimer 'Set timer to go off every 1 minute
End Sub

in a Module add the following:

Public Declare Function SetTimer Lib "user32" ( _
ByVal HWnd As Long, ByVal nIDEvent As Long, _
ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long

Public Declare Function KillTimer Lib "user32" ( _
ByVal HWnd As Long, ByVal nIDEvent As Long) As Long
Public TimerID As Long, TimerSeconds As Single, tim As Boolean
Dim Counter As Long
Sub LookForNew()
  Dim mess_body As String, StrFile As String, StrPath As String
  Dim appOutLook As Outlook.Application
  Dim MailOutLook As Outlook.MailItem

  Set appOutLook = CreateObject("Outlook.Application")
  Set MailOutLook = appOutLook.CreateItem(olMailItem)
  Dim n As String, msg As String, d As Date
  msg = ""
  Set fso = CreateObject("Scripting.FileSystemObject")
  Set fils = fso.GetFolder("<<<Put your folder here>>>").Files
  For Each fil In fils
    n = fil.Name
    d = fil.DateCreated
    If d >= Date - 1 Then
      msg = msg & n & vbTab & d & vbCrLf
    End If
  Next fil
  If msg <> "" Then
    StrPath = "<<<Put your folder here>>>\" 'attention to the extra "\"
      With MailOutLook
       .BodyFormat = olFormatRichText
       .To = "<<<Put your Mail-Adress here>>>"
       .Subject = "Scan"
       .HTMLBody = msg
       StrFile = Dir(StrPath & "*.*") '~~> *.* for all files
       Do While Len(StrFile) > 0 'loop through all files in the Folder
       .Attachments.Add StrPath & StrFile
       StrFile = Dir
       Loop
       .DeleteAfterSubmit = True 'delete Mail from Send Items
       .Send
      End With
    Kill StrPath & "*.*" 'delete all files from Folder
  End If
  Set fso = Nothing
End Sub

Sub StartTimer()'~~> Start Timer
'~~ Set the timer for 60 second
TimerSeconds = 60
TimerID = SetTimer(0&, 0&, TimerSeconds * 1000&, AddressOf TimerProc)
End Sub

Sub EndTimer()'~~> End Timer
On Error Resume Next
KillTimer 0&, TimerID
End Sub

Sub TimerProc(ByVal HWnd As Long, ByVal uMsg As Long, _
ByVal nIDEvent As Long, ByVal dwTimer As Long)
Call LookForNew ' call your existing or modified code here
End Sub

Thanks for spending the time to submit that Dan - As it happens I write a working scrips the day after I posted this, very much along the lines of what you posted but with a few tweaks doe toe its exact needs. — Digital Lightcraft, Jul 31 '17 at 13:24

How do I get Outlook to periodically check a folder for files then email them out?

1 Answers1