Outlook程序移动附件 [英] Outlook program to move Attachments

问题描述

我已经在VS2010中编写了这个小程序，可以在Outlook 2007上运行.

它适用于标准的收件箱通读，但无法正确指向其他文件夹，我收到用户代码未处理COMException"错误，提示操作失败.找不到对象. " ...

我的Outlook结构的顶部带有"Outlook(Gary)".收件箱Kickabout都是位置属性为"\\ Outlook(Gary)"的第一级文件夹，而Attachments文件夹位于Kickabout内，并且其位置属性为"\\ Outlook(Gary)\ Kickabout".

所以找不到什么?！?

I have written this small program in VS2010 to run on Outlook 2007.

It works for a standard read through of the Inbox, but I cannot get it to correctly point to other Folders, I am getting a "COMException was unhandled by user code" error that says "The operation failed. An object could not be found." ...

My Outlook structure has "Outlook (Gary)" at the top & INBOX & Kickabout are both first level Folders with Location Properties of "\\Outlook (Gary)", whereas the Attachments folder is within Kickabout and it has a Location Property of "\\Outlook (Gary)\Kickabout".

So what can''t be found ?!?

Imports Microsoft.Office.Interop

Public Class ThisAddIn
    Private Sub ThisAddIn_Startup() Handles Me.Startup
    End Sub
    Private Sub ThisAddIn_Shutdown() Handles Me.Shutdown
    End Sub
    Private Sub Application_Startup() Handles Application.Startup

        Dim MyApp As Outlook.Application = New Outlook.Application
        Dim MyNS As Outlook.NameSpace = MyApp.GetNamespace("MAPI")
        Dim MyInbox As Outlook.MAPIFolder = MyNS.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderInbox)
        Dim MyEmails As Integer = MyInbox.Items.Count
        Dim MyEMail As Outlook.MailItem
        Dim MyCount As Integer
        Dim MySubFolder As Outlook.MAPIFolder = MyNS.Folders("Kickabout") <<< Error occurs here

        For MyCount = MyEmails To 1 Step -1
            MyEMail = MyInbox.Items(MyCount)
            If MyEMail.SenderEmailAddress = "[e-mail]" Then
                If MyEMail.Attachments.Count > 0 Then
                    MySubFolder = MyNS.Folders("Kickabout\Attachments")
                End If
                MyEMail.Move(MySubFolder)
            End If
        Next
    End Sub

End Class

推荐答案

好，我自己解决了这个问题……如果有人对未来感兴趣，您必须非常明确地设定路径&；需要一个功能来执行此操作，这是代码...

OK, I have solved this myself ... if anybody is interested in the future, you have to be quite explicit in setting up the path & need a Function to do so, here is the code ...

Imports Microsoft.Office.Interop

Public Class ThisAddIn

    Dim strFolderPath As String

    Private Sub ThisAddIn_Startup() Handles Me.Startup
    End Sub
    Private Sub ThisAddIn_Shutdown() Handles Me.Shutdown
    End Sub
    Private Sub Application_Startup() Handles Application.Startup

        Dim MyApp As Outlook.Application = New Outlook.Application
        Dim MyNS As Outlook.NameSpace = MyApp.GetNamespace("MAPI")
        Dim MyInbox As Outlook.MAPIFolder = MyNS.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderInbox)
        Dim MyEmails As Integer = MyInbox.Items.Count
        Dim MyEMail As Outlook.MailItem
        Dim MyCount As Integer
        Dim MySubFolder As Outlook.Folder = GetMyFolder("Outlook (Gary)\Kickabout")
        Stop
        For MyCount = MyEmails To 1 Step -1
            MyEMail = MyInbox.Items(MyCount)
            If MyEMail.SenderEmailAddress = "[e-mail]" Then
                If MyEMail.Attachments.Count > 0 Then
                    MySubFolder = GetMyFolder("Outlook (Gary)\Kickabout\Attachments")
                End If
                MyEMail.Move(MySubFolder)
            End If
        Next
    End Sub

    Function GetMyFolder(FolderPath)
        ' folder path needs to be something like 
        '   "Public Folders\All Public Folders\Company\Sales"
        Dim aFolders
        Dim fldr
        Dim i
        Dim objNS

        On Error Resume Next
        strFolderPath = Replace(FolderPath, "/", "\")
        aFolders = Split(FolderPath, "\")

        'get the Outlook objects
        ' use intrinsic Application object in form script
        objNS = Application.GetNamespace("MAPI")

        'set the root folder
        fldr = objNS.Folders(aFolders(0))

        'loop through the array to get the subfolder
        'loop is skipped when there is only one element in the array
        For i = 1 To UBound(aFolders)
            fldr = fldr.Folders(aFolders(i))
            'check for errors
            'If Err() <> 0 Then Exit Function
        Next
        GetMyFolder = fldr

        ' dereference objects
        objNS = Nothing
    End Function
End Class

这篇关于Outlook程序移动附件的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！