Question

以下是我一直负责制作工作的建议情况：

监控电子邮件收件箱
电子邮件将附带附件“thing.foo”
我们希望能够剥离附件并保存到网络上的文件夹
这将通过监控文件夹的系统自动处理
然后，我们希望能够拾取输出文件并将其返回到原始电子邮件的发件人，其中.foo来自（假设这始终是相同的地址并已修复） < / LI>

好的，所以我很高兴到最后一点：

我将在服务器上的Outlook实例中使用一个小的VBA脚本来提取thing.foo文件，给它一个唯一的文件名（uniqueThing.foo），然后将其放在网络文件夹中。这个过程（与我无关）将运行它并保存为类似“uniqueThing_processed.foo”（可能将原始文件移动到存档文件夹）......我很乐观这一点。

现在，我需要做的是让这个Outlook实例定期检查（比如说每5分钟一次）检查“******** _ processed.foo”文件，将其附加到发送电子邮件并发送（然后可能将文件移至存档并附加“_sent”）

Answer 1

正如Alex K.所述，使用计时器：添加到＆＃34; ThisOutlookSession＆＃34;下面的

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

如何让Outlook定期检查文件夹中的文件，然后通过电子邮件发送出去？

1 个答案: