?
Solved

VBA Script Errors Out When Adding Records to Exchange Folder

Posted on 2007-07-23
6
Medium Priority
?
343 Views
Last Modified: 2013-11-27
I'm trying to synchronize an Exchange 2003 public folder (with contacts in it) with a personal CONTACT folder because the OWA (Outlook Web Access) does not support public folder access.  I have settled on using VBA for synch'ing since I can connect to the exchange folders A-OK with MS Access.  The problem comes when adding records to the personal contact folder in the VBA script.  The first record adds just fine with no error.  The second pass/attempt errors out.  Here is the code:

    Dim cn As ADODB.Connection
    Dim rsMine As ADODB.Recordset
    Dim rsPub As ADODB.Recordset
             
    Set cn = CurrentProject.AccessConnection
    Set rsPub = New ADODB.Recordset
    rsPub.ActiveConnection = cn
    rsPub.Source = "SELECT * FROM [Public - Contacts]"
    rsPub.LockType = adLockOptimistic
    rsPub.CursorType = adOpenKeyset
    rsPub.Open
    Do While Not rsPub.EOF
        Set rsMine = New ADODB.Recordset
        rsMine.ActiveConnection = cn
        rsMine.Source = "SELECT * FROM Contacts WHERE LCase(Contacts.[User Field 4]) = '" & LCase(rsPub![Email Address] & rsPub!First & rsPub!Last & "") & "';"
        rsMine.LockType = adLockOptimistic
        rsMine.CursorType = adOpenKeyset
       'The error comes on the second pass
        rsMine.Open
        If rsMine.EOF Then
            rsMine.AddNew
            rsMine![User Field 4] = rsPub![Email Address] & rsPub!First & rsPub!Last
        End If
        rsMine!First = rsPub!First
        rsMine!Last = rsPub!Last
        rsMine!Title = rsPub!Title
        rsMine!Company = rsPub!Company
        'etc
        rsMine.Update
        rsMine.Close
        Set rsMine = Nothing
        rsPub.MoveNext
    Loop
    rsPub.Close
    Set rsPub = Nothing

I have tried it with ADODB and DAO...it errors in the same logical place (no difference)
If I exit MS Access and come back in, the script will work 1 time and error out on the 2nd pass.
The exact error is...
Run-time error '-2147467259 (80004005)
Unexpected error has occurred.

Why?
0
Comment
Question by:jfeltjfelt
  • 3
  • 2
5 Comments
 
LVL 9

Expert Comment

by:mpmccarthy
ID: 19553710
As you are adding records to contacts only why have you set criteria on the source?

You then say if the recordset is at the eof then add a new record

If rsMine.EOF Then
            rsMine.AddNew
            rsMine![User Field 4] = rsPub![Email Address] & rsPub!First & rsPub!Last
        End If
        rsMine!First = rsPub!First
        rsMine!Last = rsPub!Last
        rsMine!Title = rsPub!Title
        rsMine!Company = rsPub!Company
        'etc
        rsMine.Update

This code doesn't make sense logically.  You only add a new record if you are at EOF but the update and other records insertions are outside of this if statement.  The statement can only be true once.  Once you have added this record then you would need to close and reopen the recordset to again reach the eof so the addnew statement is never triggered after the first time.
0
 

Accepted Solution

by:
jfeltjfelt earned 0 total points
ID: 19554569
Thanks for the thought, but the code is logical since EOF indicates the need for a record matching the the SELECT statement.  The error occurs on the .OPEN statement not the .EOF.  Your comment got me thinking about the number of times I open the the source, and I kept looking.  As I changed the code to only open the source once, a new error popped up "Data provider or other service returned an E_FAIL Status".  I kept searching this knowledgebase and found a note from Podnov in 2003 about only having 1 active connection at a time.  By staging the Exchange Data first to a local Access table and then moving the data from the local table back into my personal Contacts Exchange folder it worked.  When working with Exchange data and MS Access, it is best to have only one connection at a time open.  Thanks again.
0
 
LVL 9

Expert Comment

by:mpmccarthy
ID: 19554661
Not a problem.

Glad you get it working for you.
0
 
LVL 9

Expert Comment

by:mpmccarthy
ID: 19561474
No objections from me.
0
 

Author Comment

by:jfeltjfelt
ID: 19586351
After working with this problem for over a week, I have concluded that MS Access cannot reliably add records to your personal CONTACT list in Outlook or Exchange.  It just does not work.  I can delete records.  I can modify records, but adding is another story.  Have gone to using a combination of MS Access and WinBatch to automate the synchronization.  For what it's worth.
0

Featured Post

What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article describes Top 9 Exchange troubleshooting utilities that every Exchange Administrator should know. Most of the utilities are available free of cost. List of tools that I am going to explain in this article are:   Microsoft Remote Con…
There are literally thousands of Exchange recovery applications out there. So how do you end up picking one that’s ideal for your business & purpose? By carefully scouting the product’s features, the benefits it offers you, & reading ample reviews f…
Visualize your data even better in Access queries. Given a date and a value, this lesson shows how to compare that value with the previous value, calculate the difference, and display a circle if the value is the same, an up triangle if it increased…
Exchange organizations may use the Journaling Agent of the Transport Service to archive messages going through Exchange. However, if the Transport Service is integrated with some email content management application (such as an anti-spam), the admin…
Suggested Courses

621 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question