以附件移动到子文件夹
问题描述:
Outlook程序我在VS2010写了这个小程序在Outlook 2007中以附件移动到子文件夹
它的工作原理,通过收件箱中的阅读标准运行,但我不能让它正确指向其他文件夹,我得到一个“COMException被用户代码未处理”错误,说“操作失败,找不到对象”。 ...
我已经包括了我的Outlook结构的截图,如果它可以帮助...
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 = "[email protected]" Then
If MyEMail.Attachments.Count > 0 Then
MySubFolder = MyNS.Folders("Kickabout\Attachments")
End If
MyEMail.Move(MySubFolder)
End If
Next
End Sub
End Class
答
好吧,我有这个解决自己...如果有人有兴趣的未来,你必须要在建立路径&需要一个函数来做到这一点,这里是代码比较明确...
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 = "[email protected]" 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
您是否尝试过使用调试器和SETT在'Dim MySubFolder ...'行添加一个断点并展开'MyNs.Folders'树来查看里面有什么?在Exchange Web服务中,我不认为它通过名称来键入它们,而是通过ID来键入它们,并且您必须使用单独的函数来按名称查找它们。 – Origin
是的,我正在使用调试器,并且无处可寻!然而,我在Sue Mosher的旧网站www.outlookcode.com找到了一个解决方案,您是对的,我需要一个功能,我现在将代码放入... –