如何讓Outlook定期檢查文件夾中的文件，然後將它們發送出去？

Question

這裏所提出的情況，我一直在負責製作工作：

• 監視電子郵件收件箱
• 電子郵件將附件到達「thing.foo」
• 我們希望能夠剝離附着並通過系統保存到一個文件夾，在網絡上
• 這將自動過程監控的文件夾
• 然後，我們希望能夠拾取器的輸出文件，該回到原來的電子郵件的發件人，其中.foo來自（讓我們假設這是永遠不變的地址和固定）

行，所以我沒事了最後一點：

我會用一個小的VBA腳本在Outlook中的一個實例上切斷並取出thing.foo文件，爲其指定一個唯一的文件名（uniqueThing.foo），然後將其放入網絡文件夾中。 這個過程（與我無關）將運行其過程並保存爲「uniqueThing_processed.foo」（也許將原始文件移動到一個存檔文件夾）......我確定了這一點。

現在，我需要做的是讓這個Outlook實例定期檢查（「每隔5分鐘」）一個「******** _ processed.foo」文件，並將其附加到電子郵件中並把它（然後可能將文件移動到歸檔，並追加「_sent」）

Answer 1

亞歷克斯K.指出，使用計時器： 添加到「ThisOutlookSession」如下因素

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 

在

模塊添加以下內容：

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