A Microsoft Outlook email forum. Outlook Banter

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.

Go Back   Home » Outlook Banter forum » Microsoft Outlook Email Newsgroups » Outlook and VBA
Site Map Home Register Authors List Search Today's Posts Mark Forums Read Web Partners

Help with possible program flow error?



 
 
Thread Tools Search this Thread Display Modes
Prev Previous Post   Next Post Next
  #1  
Old December 11th 06, 06:31 PM posted to microsoft.public.outlook.program_vba
Rayo K
external usenet poster
 
Posts: 16
Default Help with possible program flow error?

Hello,

I have been working on a macro that will sync my MSN account with my Outlook
Sent Items. (so i keep copies of emails sent from other computers or the
website). I've gotten a lot of help from you guys (Thanks!) but there is
still something not quite right with it. I have a routine that compares the
sent time and subject to see if the item is a duplicate, and despite
everything it still finds "false positives" i.e. it copies emails that are
already in the folder. I even drew a flowchart to see what was wrong and
couldn't find it. I checked two offending tiems and confirmed the send time
and subject were identical. Perhaps someone could find the flaw in my code. I
know there are many others with more immediate problems but I would
appreciate any insight as this is driving me nuts. Thanks

Here is the code (feel free to use for yourself if you wish):


Sub CopyEmails()
'Written by Rayo Kumana 12-07-06
'Not responsible for any undesirable effects - you have been warned.

'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
 




Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

vB code is On
Smilies are On
[IMG] code is On
HTML code is Off
Forum Jump

Similar Threads
Thread Thread Starter Forum Replies Last Post
can not use the program อมามิ Outlook Express 1 November 15th 06 01:56 PM
OE Recovery Program Jim Outlook Express 5 June 6th 06 10:38 AM
Error Message- Program trying to access email address Andre Outlook - Installation 2 May 12th 06 02:20 AM
Help-Error msg popup "A program is trying to access email addresses. . ' WF Outlook - General Queries 1 April 29th 06 02:08 AM
Recent program....causing error....do you wish to fix. Malcolm Dowers Outlook - Installation 1 March 10th 06 09:29 AM


All times are GMT +1. The time now is 08:48 PM.


Powered by vBulletin® Version 3.6.4
Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.Search Engine Friendly URLs by vBSEO 2.4.0
Copyright ฉ2004-2025 Outlook Banter.
The comments are property of their posters.