Board logo

标题: [问题求助] VB Items.Find 功能问题 [打印本页]

作者: hp051247767    时间: 2015-10-22 13:23     标题: VB Items.Find 功能问题

本帖最后由 pcl_test 于 2017-5-25 14:43 编辑

此程式碼會在Outlook中尋找重覆的MAIL
找到後移動至RepeatMail
但是Subject中有 FW: 文字
再 Set myItem = myItems.Find("[Subject] = '" & Result(x) & "'") 這行就會找不到有 FW: 文字的信
沒有FW: 文字的都可正常執行
请问该如何解决??
程式码如下
  1.     Sub test()
  2.     Dim Subject(), Sender(), ReceivedTime(), Result() As String
  3.     Dim i, x, y As Integer
  4.     Dim Application As Outlook.Application
  5.     Dim myNamespace As NameSpace
  6.     Dim myFolder As MAPIFolder
  7.     Dim Folder As MAPIFolder
  8.       
  9.     Dim myItems As Outlook.Items
  10.     Dim myItem As Object
  11.     Dim myDestFolder As Outlook.Folder
  12.     Const olFolderInbox = 6
  13.     Set Application = New Outlook.Application
  14.     Set objOutlook = CreateObject("Outlook.Application")
  15.     Set myNamespace = objOutlook.GetNamespace("MAPI")
  16.     Set myFolder = myNamespace.GetDefaultFolder(olFolderInbox)    '//收件夾子文件
  17.     For y = 0 To myFolder.Folders.Count
  18.         If (y = 0) Then
  19.       
  20.             Set myItems = myFolder.Items
  21.       
  22.         Else
  23.             Set Folder = myFolder.Folders(y)
  24.             Set myItems = Folder.Items
  25.       
  26.         End If
  27.       
  28.         Set myItem = myItems.Restrict("[ReceivedTime] > '" & Date & "'")  '搜寻今天邮件
  29.         myItem.Sort "[ReceivedTime]", False    '使用接收时间排序
  30.         Set myDestFolder = myFolder.Folders("RepeatMail") '移动至 Repeat Mail 资料夹
  31.       
  32.         'Set colItems = objFolder.Items
  33.         'MsgBox Date & DateAdd("d", 1, Date)
  34.          
  35.         i = 0
  36.         For Each objMessage In myItem
  37.             ReDim Preserve Subject(i)
  38.             ReDim Preserve Sender(i)
  39.             ReDim Preserve ReceivedTime(i)
  40.       
  41.             Subject(i) = objMessage.Subject
  42.             Sender(i) = objMessage.SenderEmailAddress
  43.             ReceivedTime(i) = objMessage.ReceivedTime
  44.             'Result(i) = objMessage.Subject & "-" & objMessage.SenderEmailAddress & "-" & objMessage.ReceivedTime
  45.             'a(i) = objMessage.Subject
  46.             'MsgBox objMessage.Subject
  47.             i = i + 1
  48.         Next
  49.         If (i > 0) Then '判断是否有今天邮件
  50.             x = 1
  51.             ReDim Preserve Result(x)
  52.             'Result(x) = Subject(0)
  53.             For i = 1 To UBound(Subject)
  54.                 '判断跟前面的Array是否一样,一样就加入Result字串中
  55.                 If (Subject(i - 1) = Subject(i) And Sender(i - 1) = Sender(i)) Then
  56.                     'MsgBox Subject(i)
  57.                     ReDim Preserve Result(x)
  58.                     Result(x) = Subject(i)
  59.                     MsgBox Result(x)
  60.                     '重複MAIL移動至 RepeatMail DataFile
  61.                   
  62.                     Set myItem = myItems.Find("[Subject] = '" & Result(x) & "'")
  63.                    If (TypeName(myItem) <> "Nothing") Then
  64.                     myItem.Move myDestFolder
  65.                   
  66.                  End If
  67.                     x = x + 1
  68.                 End If
  69.             Next
  70.       
  71.             Erase Subject(), Sender(), ReceivedTime(), Result()  '清除阵列内容
  72.       
  73.         End If
  74.     Next
  75.     End Sub
复制代码





欢迎光临 批处理之家 (http://bbs.bathome.net/) Powered by Discuz! 7.2