如何在outlook中自动运行vba程序

求缺妞嫁我 · 发表于 2013-12-23 16:14

我已经写好一个vba程序，就是把邮箱中的附件分类归档。现在希望一个新邮件到达的时候就触发这个vba程序，这样，把新邮件也归档。向各位高手求助这个应该怎么写？

闻启学 · 发表于 2013-12-23 16:26

放入事件中就行

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)

这个事件 EntryIDCollection 这个获得接收的邮件的ID 这个是唯一的

能否看下代码我也做了一个收到邮件后附件自动保存到指定的路径这个功能

求缺妞嫁我 · 发表于 2013-12-23 16:37

Public myolapp As Outlook.Application

Sub initialize_handler()

Set myolapp = Outlook.Application

End Sub

Private Sub myolapp_newmail()

Dim mail As Outlook.MailItem
Dim inbox As Outlook.Folder
Dim attach As Outlook.Attachment
Dim filepath, filename, mailname As String

Set inbox = Application.GetNamespace("MAPI").Folders("个人文件夹").Folders("收件箱")

For Each mail In inbox.Items

If mail.Attachments.Count > 0 Then

For Each attach In mail.Attachments

   filename = attach.filename
   mailname = mail.Subject


   If mailname Like "*海通*" Then


   filename = attach.filename
   attach.SaveAsFile "F:\研究报告\海通证券\" & filename
   mail.Move inbox.Folders("已保存附件邮件")

   End If

   Next

   End If

   Next



End Sub

求缺妞嫁我 · 发表于 2013-12-23 16:39

闻启学发表于 2013-12-23 16:26
放入事件中就行

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)

是把这一行直接加在程序的最前面就可以了是么？

求缺妞嫁我 · 发表于 2013-12-23 17:09

继续求助。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。

闻启学 · 发表于 2013-12-23 20:50

本帖最后由闻启学于 2013-12-23 20:52 编辑

求缺妞嫁我发表于 2013-12-23 17:09
继续求助。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。

???不懂什么意思
你厉害用类来完成

求缺妞嫁我 · 发表于 2013-12-24 09:11

闻启学发表于 2013-12-23 20:50
???不懂什么意思
你厉害用类来完成

我是小白啊。。。。。。我不知道你写的那句加到我程序的哪里？能否看一下你的完整的程序？

闻启学 · 发表于 2013-12-24 09:19

本帖最后由闻启学于 2013-12-24 09:22 编辑

求缺妞嫁我发表于 2013-12-24 09:11
我是小白啊。。。。。。我不知道你写的那句加到我程序的哪里？能否看一下你的完整的程序？

厉害小白都可以用类来做

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
'//收到邮件后附件自动保存到指定的路径
Dim varEntryIDs
Dim objItem As Outlook.MailItem
Dim i As Integer
Set objItem = Application.Session.GetItemFromID(EntryIDCollection) '//根据ID号获得整个邮件
Call NewMail.NewMailSaveAttachemnets(objItem) '//附件的处理
End Sub

复制代码

Sub NewMailSaveAttachemnets(myMail As Outlook.MailItem)
'// outlook 收到新邮件是将邮件的附件自动放到指定位置
On Error Resume Next
Dim mail As Outlook.MailItem
Dim Fso As Object
Dim myOlExp As Outlook.Explorer '//outlook
Dim myOlSel As Outlook.Selection '//outlook所在选择项
Set Fso = CreateObject("Scripting.FileSystemObject") '//FSO文件对象
Dim MsgTxt As String
Dim x As Integer
Dim Folder As String
Dim reg As String
Dim MyFileName As String
Set myOlExp = Application.ActiveExplorer '//指向对象 outlook
Dim vItem As Outlook.Attachment
reg = "\d+" '//正则表达式
If myMail.Attachments.Count > 0 Then
For i = 1 To myMail.Attachments.Count
Set vItem = myMail.Attachments(i)
MyFileName = myMail.Subject
If InStr(MyFileName, "单") = 0 Then '//判断邮件主题是包含 “单”
vItem.SaveAsFile "D:" & vItem.FileName '//保存到另外一个文件夹
Else
If InStr(Split(vItem.FileName, ".")(1), "pdf") > 0 Then
'//判断是否包含该月份的文件夹，有则保存在文件夹，无则创建文件
Folder = "D:\PDF文件\2013" & Val(Mid(getRegtoString(reg, MyFileName), 5, 2)) & "月份" '//判断月份
If Not Fso.FolderExists("Folder") Then '//无则创建文件夹
Fso.CreateFolder (Folder)
End If
vItem.SaveAsFile Folder & "" & vItem.FileName '//保存附件路径
Else
vItem.SaveAsFile "D:\PDF文件\2013" & vItem.FileName '//保存到根目录文件夹
End If
End If
Next i
End If
End Sub

复制代码

求缺妞嫁我 · 发表于 2013-12-24 09:52

闻启学发表于 2013-12-24 09:19
厉害小白都可以用类来做

谢谢！我试一下看看~~~~

aoranbuqun · 发表于 2024-8-22 11:26

闻启学发表于 2013-12-24 09:19
厉害小白都可以用类来做

很高级，很实用

		自动登录	找回密码
密码			免费注册

[求助] 如何在outlook中自动运行vba程序