![]() |
If this is your first visit, be sure to check out the FAQ by clicking the link above. You may have to register before you can post: click the register link above to proceed. To start viewing messages, select the forum that you want to visit from the selection below. |
|
|
Thread Tools | Search this Thread | Display Modes |
|
#1
|
|||
|
|||
![]()
Here is my code. Thank you for your help:
Sub CopyEmails() 'handles for manipulated objects Dim app As Outlook.Application Dim space As NameSpace Dim box1 As MAPIFolder Dim box2 As MAPIFolder Dim folder1 As MAPIFolder Dim folder2 As MAPIFolder Dim itemcoll1 As Items Dim itemcoll2 As Items Dim item1 As Object Dim item2 As Object Dim itemCopy As Object Dim x As Integer, y As Integer Dim bookmark As Integer Dim numItems As Integer Dim totalCopied As Integer Dim FCont As Boolean Dim FSame As Boolean Dim FCopy As Boolean 'define the handles Set app = CreateObject("Outlook.Application") Set space = app.GetNamespace("MAPI") Set box1 = space.Folders("MSN") Set folder1 = box1.Folders("Sent Items") Set box2 = space.Folders("Rayo's Folders") Set folder2 = box2.Folders("Sent Items") Set itemcoll1 = folder1.Items Set itemcoll2 = folder2.Items 'sort items collections by send date itemcoll1.Sort "[SentOn]", True itemcoll2.Sort "[SentOn]", True 'step through all items in collection 1 numItems = itemcoll1.Count totalCopied = 0 y = 1 'bookmark marks the last y corresponding to the last time checked. It keeps from checking later emails over and over again. bookmark = 1 For x = 1 To numItems 'Set item1 to the new key, set y to the first index and turn on the continue flag. 'Really, I should be able to start at the last index because the keys were also sorted, _ but I'm not comfortable with that yet. The = code could advance the index too far. Set item1 = itemcoll1(x) y = bookmark FCont = True 'go through items in folder 2 Do While FCont 'For each iteration, the routine looks at the recevied time for item1 (the key) _ and item2 (the indexed item). 'The indexed item cycles through from last received to first. If the key time is greater _ then the key must not be in the index - otherwise it would would been equal to a prior index. 'If it is earlier than the index, we cycle back until we find an index that it is greater _ or equal to. 'If there is no item corresponding to y, then we checked every index and the email _ is not in the folder. If y itemcoll2.Count Then 'If the server is not connected, it will not copy the email On Error Resume Next Set itemCopy = item1.Copy If Err.Number Then itemCopy.Delete MsgBox "An error occurred while copying an item. Check that the folder is online.", vbOKOnly, "Terminate" GoTo Fin Else itemCopy.Move folder2 totalCopied = totalCopied + 1 End If 'item1.Copy.Move folder2 'totalCopied = totalCopied + 1 bookmark = y Exit Do End If 'Now we set the index to the new y Set item2 = itemcoll2(y) 'If the sent time is greater than the item in folder 2, the email is new _ and will be moved If item1.SentOn item2.SentOn Then 'Turn off the continue flag and copy the item FCont = False 'If the server is not connected, it will not copy the email On Error Resume Next Set itemCopy = item1.Copy If Err.Number Then itemCopy.Delete MsgBox "An error occurred while copying an item. Check that the folder is online.", vbOKOnly, "Terminate" GoTo Fin Else itemCopy.Move folder2 totalCopied = totalCopied + 1 End If 'item1.Copy.Move folder2 'totalCopied = totalCopied + 1 bookmark = y End If If item1.SentOn = item2.SentOn Then 'We have an item with the same time. The continue flag is off and the copy flag is on. _ Copying the email is the default action. FCont = False FCopy = True bookmark = y Do While item1.SentOn = item2.SentOn 'Check if emails are the same by sent time and subject. Turn on the "Same" flag 'The only time this would fail is if I sent two different emails at the same time _ with the same subject. This is unlikely. FSame = True If Not (item1.Subject = item2.Subject) Then FSame = False 'If all of these were the same, the items are considered the same, and the copy flag is turned off. If FSame Then FCopy = False 'increment the index and reset item2. This continues for all indices with the same time. y = y + 1 'If the last emails in the folder have the same time, and we reach the end, exit the loop and copy _ if the emails are different. This will probably never happen in real life, but it does while testing. If y itemcoll2.Count Then Exit Do End If Set item2 = itemcoll2(y) Loop 'If the copy flag was turned off, one the indices matched the key. It won't be copied. If we _ went through them all and found no matches, we copy the email. Either way, we're done with this key. If FCopy Then 'If the server is not connected, it will not copy the email On Error Resume Next Set itemCopy = item1.Copy If Err.Number Then itemCopy.Delete MsgBox "An error occurred while copying an item. Check that the folder is online.", vbOKOnly, "Terminate" GoTo Fin Else itemCopy.Move folder2 totalCopied = totalCopied + 1 End If 'item1.Copy.Move folder2 'totalCopied = totalCopied + 1 End If 'The continue flag is off either way, so the loop will terminate End If 'if the key is not greater than the index, and not the same, increment the index by one. y = y + 1 Loop Next x Fin: MsgBox totalCopied & " e-mails copied.", vbOKOnly, "Copying e-mails completed." End Sub "Dmitry Streblechenko" wrote: Please show your code. Are you sure the date/time properties are the same? Due to the roundoff errors, you should never expect an exact match, but rather check that the difference between two values is less than some value (e.g. millisecond). Dmitry Streblechenko (MVP) http://www.dimastr.com/ OutlookSpy - Outlook, CDO and MAPI Developer Tool "Rayo K" wrote in message ... Hello, I have a macro that is supposed to check my HTTP MSN acount for any sent emails that are not already in my OUtlook folder "Sent Items". I compare them by checking the sent time and subject. However, the code seems to treat the properties as 'not equal' even when it's the same email. Is there something about being on a HTTP server that affects the item properties such that they will evaluate as not equal? |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
Item.Save and Item.Close Script causes Outlook 2007 to Crash | Rayyan | Outlook - Using Forms | 6 | November 25th 06 03:14 AM |
How to change an item from a recurring Appointment item to an exception from VB code? | Dikbill | Outlook and VBA | 2 | July 13th 06 08:45 AM |
Saving exception item in recurring appointment item fails | Dikbill | Outlook and VBA | 2 | July 11th 06 03:59 PM |
Saving exception item in recurring appointment item fails | Dikbill | Outlook - Calandaring | 0 | July 11th 06 02:01 PM |
Sender Properties | [email protected] | Outlook and VBA | 4 | July 6th 06 03:34 PM |