[求助]microsoft outlook批量保存附件问题（就差一点完成）

gaosi2772

就是版主在7楼回答的下半部分!

Sub Savetheattachment()
    Dim olApp As New Outlook.Application
    Dim nmsName As Outlook.NameSpace
    Dim fldFolder As Outlook.Folder
    Dim vItem As Object
    Set nmsName = olApp.GetNamespace("MAPI")
    Set fldFolder = nmsName.GetDefaultFolder(olFolderInbox)
    If fldFolder.UnReadItemCount > 0 Then
        For Each vItem In fldFolder.Items
           If vItem.UnRead = True Then
           strname = vItem.Subject'这个可不要,注释掉
           strname = Replace(strname, "*", "_")'这个可不要,注释掉
           strname = Replace(strname, "\", "_")'这个可不要,注释掉
           strname = Replace(strname, "/", "_")'这个可不要,注释掉
           strname = Replace(strname, "$", "_")'这个可不要,注释掉
           strname = Replace(strname, "%", "_")'这个可不要,注释掉
           strname = Replace(strname, "!", "_")'这个可不要,注释掉
           strname = Replace(strname, "~", "_")'这个可不要,注释掉
           strname = Replace(strname, "(", "_")'这个可不要,注释掉
           strname = Replace(strname, ")", "_")'这个可不要,注释掉
           strname = Replace(strname, "+", "_")'这个可不要,注释掉
           strname = Replace(strname, ":", "_")'这个可不要,注释掉
           vItem.SaveAs "C:\" & strname & ".txt", olTXT'这个可不要,注释掉
           '-----保存附件-------
           For Each att In vItem.Attachments
               att.SaveAsFile "C:\" & att.FileName
                '使用shell print打印文档
              ' strFile = "C:\" & att.DisplayName '这个注释掉
                ' 下一个文档
              '  ReturnVal = ShellExecute(0&, "print", strFile, 0&, 0&, 0&)'这个注释掉
           Next
           '------保存附件--------
           vItem.UnRead = False
           End If
        Next
    End If
    Set fldFolder = Nothing
    Set nmsName = Nothing
End Sub

学习知识

请版主指教。


我上传的图片为什么看不见？

[此贴子已经被作者于2007-9-6 9:46:53编辑过]

aaaaabbbbb

楼主的已经可以了，你的不行吗？请看11楼代码。

学习知识

用了11楼的代码。
其中：“Dim fldFolder As Outlook.Folder”提示错误　“编译错误：用户定义类型未定义”。（我不会把我的屏考发到帖子里）

我把这条语句删除了。程序好用了，功能也没少什么。看来问题这样就可以算解决了。（但，象我这样照猫画虎，写程序，还得改原代码，心里没底，不知道这样做行吗？“Dim fldFolder As Outlook.Folder”这条语句的作用是什么？）

另外，1、我想可不可以解决，同名文件的存储问题（如两个邮件都有附件AAA，用现在程序，后附件覆盖前附件，我想能不能象新建文件一样，将后来的附件存储为AAA（1）等，加以区分）。
2、我每月都要接收大量不同的格式的邮件附件。我现在用规则对邮件分类存储。我想利用上述程度自动存储附件。但我要求存的邮件不在“收件箱”中，而是我自己定义的文件夹中。请版主帮助。

aaaaabbbbb

在OUTLOOK里插入模块，然后把11楼代码拷贝进去，我刚才又试了，还是可以。可以把那些我标明注释掉的代码注释了。
这句话一定要有的，Dim fldFolder As Outlook.Folder的意思是定义一个变量为outlook的文件夹，以上代码应该会用最新的附件覆盖同名的附件。
如果你想用规则分类，那就用工具栏中的“规则和通知”，如果想按各文件夹进行自动存储是有可能的，需要更改11楼的代码。以下信息可以用到。

Folders 对象

包含一组 Folder 对象，这些对象表示文件夹树某一级别上特定子集中所有可用的 Outlook 文件夹。

说明

使用 Folders 属性可从 NameSpace 对象中返回 Folders 对象或其他 Folder 对象。

使用 Folders(index) 可返回单个 Folder 对象，其中 index 是名称或索引号。文件夹名称区分大小写。

示例

以下 Visual Basic for Applications (VBA) 示例返回名为“Old Contacts”的文件夹。

Visual Basic for Applications
Set myOlApp = Outlook.Application Set myNameSpace = myOlApp.GetNameSpace("MAPI") Set myFolder = _ myNameSpace.GetDefaultFolder(olFolderContacts) Set myNewFolder = myFolder.Folders("Old Contacts")

以下 Visual Basic for Applications 示例返回第一个文件夹。

Visual Basic for Applications
Set myNewFolder = myFolder.Folders(1)

[此贴子已经被作者于2007-9-8 2:32:43编辑过]

[ 本帖最后由 aaaaabbbbb 于 2009-4-21 23:28 编辑 ]

学习知识

这条语句不能删除，但它提示错误，我该如何：

请指教。

好象楼主也出现过这个问题。不知道是如何调整好的。

[此贴子已经被作者于2007-9-8 13:27:28编辑过]

aaaaabbbbb

你把这句话注释掉，再手动写一遍，看是否输入的过程中能够联想，比如输入点号时，联想出后面的folder？

学习知识

按版主提示：

这条语句（Dim fldFolder As Outlook.Folder）。

录入...Outlook.后没有Folder,只有Folders,录入后也有错误。

后来我在提示中找到了MAPIFolder（就是说把这条语句改成Dim fldFolder As Outlook.MAPIFolder）。程序通过了。

请教版主，这样改可否？还有就是原程序，在我的机器中为什么不能通过，是不是我的Outlook缺什么组件？

学习知识

怎么没有答了，这样作可以吗？

将　　　　Dim fldFolder As Outlook.Folder

改成　　　Dim fldFolder As Outlook.MAPIFolder

haha_xion

和楼上兄弟一样遇到同一问题，望解决！