服务器的空间已经所剩无几了,只好把每天的传真邮件从邮箱里面移动到别的服务器上的公共文件夹。
考虑了很多方式无法访问传真账号的邮件,只能从Outlook中登陆后访问。2种方法可以移动邮件,1、使用规则,但是没有办法做到自动改变时间。2、vba程序,但是无法自动启动。
不过还是vba可以由点希望。
大概思路:
1、使用vba监测邮件的时间,一个月内的邮件保留,其他的作出动作,转移到公共文件夹,做好计数,然后发出日志邮件,最后退出。
2、如果是vba必须是进入outlook之后才能够启动的。那么需要做一个自动启动outlook和启动outlook后立即触发vba程序的2个启动程序。因此,使用一个计划任务,定时启动outlook。然后再applation starup 的session事件中启动vba的过程,这样便可以定时启动outlook的vba勒。
3、最后不要忽略一点再applation starup 的session事件一定要检测当前时间时候与计划任务的启动时间相符,否则每次人工启动的时候也会进行vba的任务的。考虑到实际情况,可能机器运行计划任务的时候会很慢,那么当启动applation starup 的session事件的时候的时间不是里面检测的时间,vba也就不会启动,因此应该在时间检测的时候给定一个时间范围而不是一个时间点。
考虑了很多方式无法访问传真账号的邮件,只能从Outlook中登陆后访问。2种方法可以移动邮件,1、使用规则,但是没有办法做到自动改变时间。2、vba程序,但是无法自动启动。
不过还是vba可以由点希望。
大概思路:
1、使用vba监测邮件的时间,一个月内的邮件保留,其他的作出动作,转移到公共文件夹,做好计数,然后发出日志邮件,最后退出。
2、如果是vba必须是进入outlook之后才能够启动的。那么需要做一个自动启动outlook和启动outlook后立即触发vba程序的2个启动程序。因此,使用一个计划任务,定时启动outlook。然后再applation starup 的session事件中启动vba的过程,这样便可以定时启动outlook的vba勒。
3、最后不要忽略一点再applation starup 的session事件一定要检测当前时间时候与计划任务的启动时间相符,否则每次人工启动的时候也会进行vba的任务的。考虑到实际情况,可能机器运行计划任务的时候会很慢,那么当启动applation starup 的session事件的时候的时间不是里面检测的时间,vba也就不会启动,因此应该在时间检测的时候给定一个时间范围而不是一个时间点。
Sub movefax() Dim emaildate As Date mytime = DateAdd("m", -1, Date) i = 0 Set myOlApp = CreateObject("Outlook.Application") Set myNameSpace = myOlApp.GetNamespace("MAPI") Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox) Set myItems = myInbox.Items Set faxbox = myNameSpace.GetDefaultFolder(olPublicFoldersAllPublicFolders) Set myDestFolder = faxbox.Folders("Fax Tianjin") Set myItem = myItems.Find("[SenderName] = 'The HylaFAX Receive Agent'") While TypeName(myItem) <> "Nothing" thistime = myItem.SentOn emaildate = DateValue(Year(thistime) & "-" & Month(thistime) & "-" & Day(thistime)) If emaildate < mytime Or emaildate = mytime Then i = i + 1 myItem.Move myDestFolder End If Set myItem = myItems.FindNext Wend Dim myMail As Outlook.MailItem Set myMail = Application.CreateItem(olMailItem) With myMail .To = "it@fax.cn" .Subject = "TJ Fax Move" .Body = i & " Items have been moved" End With myMail.Send End Sub Private Sub Application_Startup() thistime = Time Dim runtime1 As Date Dim runtime2 As Date runtime1 = "01:09:00" runtime2 = "01:11:00" If thistime > runtime1 And thistime < runtime2 Then Call movefax Me.Quit End If End Sub
取得邮件的另一种办法:
For i = 1 To myItems.Count Set myItem = myItems(i) thistime = myItem.CreationTime emaildate = DateValue(Year(thistime) & "-" & Month(thistime) & "-" & Day(thistime)) If emaildate < mytime Or emaildate = mytime Then m = m + 1 mysub = myItem.Subject myItem.Delete 'myItem.UnRead = False 'Debug.Print i & ":" & emaildate & "Deleted" Else k = k + 1 'Debug.Print k & ":------" & myItem.Subject End If Set myItem = myItems.GetNext Next