求自动转存附件的代码

huyongapple

OUTLOOK的对象模型一点都不懂，求帮编写一段代码：

OUTLOOK 2010中，有新邮件到达“气象”文件夹时，将其中的附件（多个）转存到指定文件夹（如我的文档）。

先谢了

huyongapple

找到了http://club.excelhome.net/thread-745167-1-1.html，学习编写了如下代码，测试能满足需要。
Private Sub Application_NewMail()
    Dim MyNameSpace As NameSpace
    Dim MyFolder As folder
    Dim MyMailitems As Items
    Dim MyItem As MailItem
    Dim MyAtta As Attachment
    Dim fPath As String
    Dim Myolapp As New Outlook.Application
   
    Set MyNameSpace = Myolapp.GetNamespace("MAPI")
    Set MyFolder = MyNameSpace.Folders("Outlook 数据文件").Folders("气象")
    Set MyMailitems = MyFolder.Items
   
    Set Fs = CreateObject("Scripting.FileSystemObject")
    fPath = "D:\MyDocuments\Documents\"
    If Not Fs.FolderExists(fPath) Then
       MsgBox fPath & " 不存在！", vbOKOnly
       End
    End If
   
    For Each MyItem In MyMailitems
       If MyItem.UnRead Then
           For Each MyAtta In MyItem.Attachments
               tmp = MyAtta.FileName
               If Not Fs.fileExists(fPath & tmp) Then
                   MyAtta.SaveAsFile fPath & tmp
               End If
           Next MyAtta
       End If
    Next MyItem
End Sub

第一次编写OUTLOOK的代码，好费力，请指正。