关于保存OUTLOOK附件的问题

kangatang · 发表于 2011-7-20 15:25

以下是保存OUTLOOK所有附件的VBS代码，请问各位大师，如果只保存指定一封邮件的附件，改如何改动代码（虽然显得不实用，但本人急需）。
非常谢谢！

'----------------------------------------------------------------
Const olFolderInbox = 6

Set objOutlook = CreateObject("Outlook.Application")
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set objFolder = objNamespace.GetDefaultFolder(olFolderInbox)

Set colItems = objFolder.Items
On error Resume Next
For Each objMessage in colItems
intCount = objMessage.Attachments.Count
If intCount > 0 Then
      For i = 1 To intCount
         objMessage.Attachments.Item(i).SaveAsFile "E:\KK\emai_lattachment\" &  _
            objMessage.Attachments.Item(i).FileName
      Next
End If
Next
'-----------------------------------------------------------------------

dsd999 · 发表于 2011-7-20 15:45

指定的附件有没规律？

kangatang · 发表于 2011-7-20 16:10

大师您好，
感谢指点。
指定的附件在当前正在阅读的邮件中。

这是本人在原基础上修改的代码。（不是最好的效果），通过指定邮件标题("Test attachment")来实现的。很笨拙。

Const olFolderInbox = 6

Set objOutlook = CreateObject("Outlook.Application")
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set objFolder = objNamespace.GetDefaultFolder(olFolderInbox)

Set colItems = objFolder.Items
On error Resume Next

For Each objMessage in colItems
  If objMessage.Subject = "Test attachment" Then
intCount = objMessage.Attachments.Count
If intCount > 0 Then
      For i = 1 To intCount
         objMessage.Attachments.Item(i).SaveAsFile "E:\KK\emai_test\" &  _
            objMessage.Attachments.Item(i).FileName
      Next
   End If
End If
Next

dsd999 · 发表于 2011-7-20 17:00

你的需求就是标题包含“Test attachment”的邮件，就保存附件？

kangatang · 发表于 2011-7-21 12:26

感谢热心的大师，
指定邮件是指：当前正在查看的邮件。
current item? 这些我都不懂。

dsd999 · 发表于 2011-7-21 16:51

你是想保存当前查看的邮件的附件，对吧。

kangatang · 发表于 2011-7-22 11:40

是的。我就是这个意思。有法子吗？

dsd999 · 发表于 2011-7-22 15:57

有办法。

就是在新打开的窗口加个按钮，然后实现保存附件功能。

行吗？

kangatang · 发表于 2011-7-23 23:09

太谢谢了。用VBS能实现吗？

dsd999 · 发表于 2011-7-26 13:37

能实现，你参考我的这个帖子。

http://club.excelhome.net/thread-651088-1-1.html

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

[求助] 关于保存OUTLOOK附件的问题

回复 2楼 dsd999 的帖子

回复 4楼 dsd999 的帖子

最新热点 /1