利用VBA自动保存outlook附件
创建VBA方法如下：
Public p As String '文件保存位置，也是解压文件存放位置
Public Sub SaveAttach(Item As Outlook.MailItem)
p = "C:\Users\Administrator.TXV6HLXTU3ZW8KD\Desktop\"
SaveAttachment Item, p, "*.rar"
'此处*.rar可以改成其他正则表达式
' MsgBox "附件已保存"
' 保存附件
' path为保存路径，condition为附件名匹配条件
Private Sub SaveAttachment(ByVal Item As Object, path$, Optional condition$ = "*")
Dim olAtt As Attachment
Dim i As Integer
Dim m As Long
Dim s As String
If Item.Attachments.Count & 0 Then
For i = 1 To Item.Attachments.Count
Set olAtt = Item.Attachments(i)
If olAtt.FileName Like condition Then
olAtt.SaveAsFile path & olAtt.FileName
'以下部分为解压rar文件，p为保存位置
s = "C:\Program Files\WinRAR\WinRAR.exe" & " X " & path & olAtt.FileName & " " & p '注意找到解压软件位置
m = Shell(s, vbHide)
Set olAtt = Nothing
在outlook中新建规则，选择动作为执行脚本，选择脚本为此方法，即可实现收到邮件后自动保存附件并解压到桌面。
保存附件代码
Sub 保存非标表格(mailitem As Outlook.mailitem)
Dim olAtt As Attachment
Set olAtt = mailitem.Attachments(1)
olAtt.SaveAsFile "D:\baidu\Desktop\丝路非标邮件\非标\" & olAtt.FileName
遍历文件夹获取正文HTML代码
Sub 遍历已有丝路()
Dim NS As Outlook.NameSpace
Dim folder As MAPIFolder
Dim mailitem As mailitem
Dim output, cmd, datetime As String
Dim num, temp As Integer
Set NS = Session.Application.GetNamespace("MAPI")
Set folder = NS.GetDefaultFolder(olFolderInbox).Folders("丝路")
num = folder.Items.Count
For i = 1 To num
Set mailitem = folder.Items(i)
If InStr(mailitem.Subject, "百度丝路运营数据报表") & 0 Then
output = "D:\baidu\Desktop\丝路非标邮件\丝路\丝路邮件" & Right(mailitem.Subject, 10) & "_" & temp & ".txt"
Open output For Output As #1
Print #1, mailitem.HTMLBody
'关闭文本文件
temp = temp + 1
没有更多推荐了，查看: 5209|回复: 2
Outlook中用VBA获取指定文件夹里的邮件
阅读权限20
在线时间 小时
是这样的，我在mailbox中自己新建了一个名为“aaa”的文件夹，我想在outlook打开的时候获取这个文件夹对象。求高手指点
阅读权限100
在线时间 小时
Set nsMyNameSpace = Application.GetNamespace(&MAPI&)
Set fl = nsMyNameSpace.Folders
set myfl = fl(&aaa&)
myfl就是你要的文件夹对象
阅读权限20
在线时间 小时
& & & & & & & &
原帖由 dsd999 于
13:37 发表
Set nsMyNameSpace = Application.GetNamespace(&MAPI&)
Set fl = nsMyNameSpace.Folders
set myfl = fl(&aaa&)
myfl就是你要的文件夹对象
您这个方法我试过了，不行啊。
Outlook 数据存储区内有一组支持 Outlook 默认功能的文件夹。使用 GetDefaultFolder(index) 返回 Outlook NameSpace 对象中某个默认的 Outlook 文件夹。其中 index 是以下 OlDefaultFolders 常量之一：olFolderCalendar、olFolderContacts、olFolderDeletedItems、olFolderDrafts、olFolderInbox、olFolderJournal、olFolderNotes、olFolderOutbox、olFolderSentMail、和 olFolderTasks。
Set myOlApp = CreateObject(&Outlook.Application&)
Set myNameSpace = myOlApp.GetNameSpace(&MAPI&)
Set myFolder= myNameSpace.GetDefaultFolder(olFolderInbox)
上面语句能获得默认的文件夹对象
上面的都是系统默认文件夹，但和上面同级的自定义文件夹怎样才能获得他们的对象名啊？怎样才能去操作啊？
玩命加载中，请稍候
玩命加载中，请稍候
Powered by
本论坛言论纯属发表者个人意见，任何违反国家相关法律的言论，本站将协助国家相关部门追究发言者责任！ & & 本站特聘法律顾问：徐怀玉律师 李志群律师vbaOUTLOOK
说明：&&在EXCEL VBA 环境下使用OUTLOOK 自动发送邮件的代码(In the EXCEL VBA environment, the use of OUTLOOK code to automatically send e-mail)
文件列表：
使用OUTlook自动发邮件.txt
近期下载者：
相关文件：在Outlook中用VBA导出HTML格式邮件 - Nina - 博客园
我每天所收到的e-mail中，订阅的电子杂志占了很大的比例。其中既有新闻也有电脑技术或娱乐性文章，加在一起竟有上百封。后来我知道单位里许多人同我一样也喜欢看，而且有的人还订了同样的杂志，所以我就每天收到邮件后把它们整理到局域网上去。只是这么多的邮件，整理起来工作量可不小，怎么解决一下呢？
　　 这些邮件通常都是HTML格式的，用Outlook通常的方法不能正确的导出，而且分布在许多下层子夹中，导出很麻烦。我在OUTLOOK中，用VBA实现了HTML邮件导出并自动发布到网络上。
　　 要对邮件箱里的邮件进行操作，首先要取得Outlook MAPI名字空间。可以使用下面的语句：
　　 Dim mobjOutlook As Outlook.NameSpace
　　 Dim objOutlook As New Outlook.Application
　　 mobjOutlook=objoutlook.GetNameSpace(&MAPI&)
　　 用mobjOutlook的GetDefaultFolder方法。可以取得收件箱的MAPIFolder对象：
　　 Dim objFolder As Outlook.MAPIFolder
　　 ObjFolder=mobjOutlook.GetDefaultFolder(6)
　　 其中参数6代表收件箱，其他参数的意义如下表：
　　 OlFolderDeletedItems
已删除邮件
OlFolderOutbox
OlFolderSentMail
已发件邮件
olFolderInbox
OlFolderCalendar
OlFolderContacts
olFolderJournal
olFolderNotes
olFolderTasks
olFolderDrafts
　　 在objFolder的属性包含邮件项集合即ITEMS，也包含所有下一级子夹的集合Folders。
　　 对每一个邮件，首先取得邮件的接收时间，如果是当天收到的就创建并打开一个HTML文件，以其主题Subject为文件名，把它的HTML格式的内容，即HTMLBody属性的值写入这个文件，然后关闭并处理下一个。
　　 对下一级子夹，用递归调用的方式，可以遍历收件箱中每一层夹中的所有邮件。在生成邮件文件时，还同时生成索引文件。
完整的程序如下：
　　 Private mobjOutlook As Outlook.NameSpace
　　 Private fs, fo
　　 Private Sub GetOutlook()
　　 Dim objOutlook As New Outlook.Application
　　 Set mobjOutlook = objOutlook.GetNamespace("MAPI")
　　 End Sub
　　 Sub ListMailFolders(objFolder As Outlook.MAPIFolder)
　　 Dim objItem As Object
　　 Dim f
　　 Dim str1, str2, str3 As String
　　 For Each objItem In objFolder.Items
　　 If (FormatDateTime(objItem.ReceivedTime, vbShortDate) = FormatDateTime(Date, vbShortDate)) Then
　　 str2 = objItem.Subject
　　 str1 = "j:wwwrootnews" + str2 + ".htm"
　　 Set f = fs.OpenTextFile(str1, 2, True, TristateFalse)
　　 f.Write objItem.HTMLBody
　　 f.Close
　　 str3 = "& p&& a href='" + objItem.Subject + ".htm'&" + objItem.Subject + "& /a&& /p& "
　　 fo.Write str3
　　 End If
　　 Dim objf As Outlook.MAPIFolder
　　 For Each objf In objFolder.Folders
　　 ListMailFolders objf
　　 Set objItem = Nothing
　　 End Sub
　　 Sub ListMailItems(longFolder As Long)
　　 Dim objFolder As Outlook.MAPIFolder
　　 Dim f
　　 If mobjOutlook Is Nothing Then
　　 GetOutlook
　　 End IF
　　 Set objFolder = mobjOutlook.GetDefaultFolder(longFolder)
　　 ListMailFolders objFolder
　　 End Sub
　　 Private Sub storemail()
　　 Set fs=CreateObject(&Scripting.FileSystemObject&)
　　 Set fo=fs.OpenTextFile(&j:wwwrootnewsindex.html&,2,True,TristateFalse)
　　 fo.Write && HTML&& HEAD&& META content=&text/ charset=gb2312& http-equiv=Content-Type& & TITLE&& /TITLE&& /HEAD&& BODY&
　　 ListMailItems(6)
　　 fo.Write && /BODY&& /HTML&&
　　 fo.Close
　　 End Sub
　　 在Outlook2000中创建一个新的宏，用VB编辑器编辑它，把上面的程序拷贝到同一模块，注意把生成文件的目录名改为自己WEB服务器上的WWW服务根文件夹名。在宏中调用storemail，执行宏，就可以导出当天收到的所有邮件。
　　 所有指向这些HTML文件的链接放在同一目录下的index.html中，这样每个人都可以在网上浏览这些文章了。查看: 3454|回复: 7
急求outlook邮件保存到电脑的VBA
阅读权限10
在线时间 小时
& & & & & & & &
本帖最后由 woshiwocd 于
06:05 编辑
各位高手，在下要写一个将outlook的邮件保存到电脑指定文件夹的macro vba, 邮件以msg的形式保存并以日期和邮件的主题命名。 急等，请各位帮帮忙啊，万分感谢啊
阅读权限100
在线时间 小时
参考下，不会再问。
阅读权限10
在线时间 小时
本帖最后由 woshiwocd 于
06:04 编辑
版主大人您好，
我自己写了一个, 但是运行到MonMail.SaveAs Path这行就出错，说失败，实在不明白，菜鸟啊，版主大人能看看吗？万分感谢。代码如下:
Private Sub SaveMail()
Dim f As String
f = &保存文件夹路径&
Set fso = CreateObject(&Scripting.FileSystemObject&)
& & If fso.FolderExists(f) && True Then
& & fso.CreateFolder (f)
Dim MonApply As Outlook.Application
Dim MonMail As Outlook.MailItem
Dim MonNSpace As Outlook.NameSpace
Dim MonDossier As Outlook.Folder
Set MonApply = Outlook.Application
Set MonNSpace = MonApply.GetNamespace(&MAPI&)
Set MonDossier = MonNSpace.GetDefaultFolder(olFolderInbox)
For i = 1 To MonDossier.Items.Count
Set MonMail = MonDossier.Items(i)
Dim Path As String
Path = f & &\& & Left(MonMail.ReceivedTime, 10) & &-& & MonMail.Subject & &.msg&
MonMail.SaveAs Path
Next iEnd sub
阅读权限100
在线时间 小时
MonMail.ReceivedTime&&有“/&，文件名不合法。
阅读权限10
在线时间 小时
谢谢版主大人
阅读权限20
在线时间 小时
楼主，给个完整版代码吧。。还有vb怎么用啊。。。
阅读权限20
在线时间 小时
谢谢版主大人
Path = f & &\& & Left(Replace(MonMail.ReceivedTime, &/&, &-& ), 10) & &-& & MonMail.Subject & &.msg&
楼主你好, 我按版本说的，修改了时间，但只提取一部分邮件，请问有完整的代码可以提供下吗？谢谢
阅读权限20
在线时间 小时
& & & & & & & &
直接鼠标选中所有要保存的邮件，拖拽到你要保存的地方就ok了，这方法一般人我不告诉他。。。。
玩命加载中，请稍候
玩命加载中，请稍候
Powered by
本论坛言论纯属发表者个人意见，任何违反国家相关法律的言论，本站将协助国家相关部门追究发言者责任！ & & 本站特聘法律顾问：徐怀玉律师 李志群律师