Help with OL07 macro to fix invalid entryid

G

genegiannamore

I have 2 users that use iphones. Somehow, the syncing of contacts in the
iphone to OL03/07 (both were upgraded from 03), has caused an invalid entryid
on most of the contacts, when anyone opens them from the address book (also
causes email to not send -get stuck in outbox- if the address book is used).
Someone on the apple forum posted an ol07 macro. I used it. It fixed about
50% of the problem contacts, then errors out with an error 13 type mismatch
on the first NEXT statement. Here is the code (BTW it looks strange, it looks
recursive);
<STARTMACROCODE>

Option Explicit

Sub FixEntryIDs()
Call FixEntryID
End Sub

Sub FixEntryID(Optional ByVal contacts As folder)
Dim item As ContactItem
Dim subf As folder
Dim changed As Boolean

If IsMissing(contacts) Or contacts Is Nothing Then
Set contacts = ActiveExplorer.CurrentFolder
End If

For Each item In contacts.Items
changed = False
If Len(item.Email1DisplayName) Then
changed = True
item.Email1DisplayName = ""
End If

If Len(item.Email2DisplayName) Then
changed = True
item.Email2DisplayName = ""
End If

If Len(item.Email3DisplayName) Then
changed = True
item.Email3DisplayName = ""
End If

If changed Then
Call item.Save
End If
Next

For Each subf In contacts.Folders
Call FixEntryID(subf)
Next
End Sub
 
K

Ken Slovak - [MVP - Outlook]

Are there any distribution lists in that contacts folder? Your code would
error out if there were. You should be checking for item.Class = olContact
before you assign an item as a ContactItem.
 
G

genegiannamore

Like this?
Option Explicit

Sub FixEntryIDs()
Call FixEntryID
End Sub

Sub FixEntryID(Optional ByVal contacts As folder)
Dim item As ContactItem
Dim subf As folder
Dim changed As Boolean

If IsMissing(contacts) Or contacts Is Nothing Then
Set contacts = ActiveExplorer.CurrentFolder
End If

For Each item In contacts.Items
If item.Class = olContact Then
changed = False
If Len(item.Email1DisplayName) Then
changed = True
item.Email1DisplayName = ""
End If

If Len(item.Email2DisplayName) Then
changed = True
item.Email2DisplayName = ""
End If

If Len(item.Email3DisplayName) Then
changed = True
item.Email3DisplayName = ""
End If

If changed Then
Call item.Save
End If
End If
Next

For Each subf In contacts.Folders
Call FixEntryID(subf)
Next
End Sub
 
G

genegiannamore

looks like maybe I get the error because item = nothing
maybe it has reached the end of the collection? seems strange, for a for
loop to reach the end of a collection and then have an error?
so the error is actually in the for loop testing the condition, if this
situation of item = nothing is normal, then I should have better coding to
deal with this. This is so weird to code without a complete language and
object reference with extensive examples. Right now I have to search just to
find a partial language reference, and not very many examples.
Want to recommend a book that covers the entire VBA, VBS, and VB language
(with out without object references), then I would purchase the books for
each object model (outlook, CDO, Excel, WMI, etc.). I am just so used to
grabbing 1 book for all syntax (ansi C, pascal, c++). The way I was taught to
code was to learn syntax first, but now it just feels different.
 
K

Ken Slovak - [MVP - Outlook]

If you declare "item As ContactItem" you shouldn't use it in the For loop.
I'd declare something like "Obj As Object" and use that in the loop, then
test it for Class before assigning it to the item object.

I doubt you reached the end, a For Each item In Contacts.Items would quit
when there were no more items.
 
A

Aaron

I had the same problem for one of my clients with the iphone sync,

Howver it just wasn't limited to email contacts, the invalid entryid was
also coming through with non email contacts ie ... contacts that had only
phone numbers in outlook. I modifed that first bit of code with an entry to
add a bogus email address then remove it. I have never wrote in Visual Basic
before so if it is slopy I appologize.

This was used in Outlook 2007, with not Distribution groups at all. Also one
thing I did notice is that it won't find the contact folder automaticly, I
had outlook contacts as the active folder before running it.

Option Explicit

Sub FixEntryIDs()
Call FixEntryID
End Sub

Sub FixEntryID(Optional ByVal contacts As Folder)
Dim item As ContactItem
Dim subf As Folder
Dim changed As Boolean

If IsMissing(contacts) Or contacts Is Nothing Then
Set contacts = ActiveExplorer.CurrentFolder
End If

For Each item In contacts.Items
changed = False
If Len(item.Email1DisplayName) Then
changed = True
item.Email1DisplayName = ""
End If

If Len(item.Email2DisplayName) Then
changed = True
item.Email2DisplayName = ""
End If

If item.Email1Address = "(e-mail address removed)" Then
item.Email1Address = ""
Call item.Save
End If



If Len(item.Email3DisplayName) Then
changed = True
item.Email3DisplayName = ""
End If

If changed Then
Call item.Save
End If
Next

For Each subf In contacts.Folders
Call FixEntryID(subf)
Next
End Sub



Aaron
 
G

genegiannamore

I wonder if the macro should look like this;
Option Explicit

Sub FixEntryIDs()
Call FixEntryID
End Sub

Sub FixEntryID(Optional ByVal contacts As folder)
Dim item As ContactItem
Dim subf As folder

If IsMissing(contacts) Or contacts Is Nothing Then
Set contacts = ActiveExplorer.CurrentFolder
End If

For Each item In contacts.Items
if item is nothing then
debug.print "Skipped"
else
If item.Class = olContact Then
If item.Email1Address = "" Then
item.Email1Address = "(e-mail address removed)"
End If
item.Save
If item.Email1Address = "(e-mail address removed)" Then
item.Email1Address = ""
End If
If Len(item.Email1DisplayName) Then
item.Email1DisplayName = ""
End If
If Len(item.Email2DisplayName) Then
item.Email2DisplayName = ""
End If
If Len(item.Email3DisplayName) Then
item.Email3DisplayName = ""
End If
item.save
End if
End If
Next

For Each subf In contacts.Folders
FixEntryID subf
Next
End Sub

Sorry if I sounded like a jerk on the earlier post, no excuse, this is a
very frustrating thing. The cause of the problem has been removed, but the
damage has been done, and I still need to fix that. I think I may have to
export to something other than pst (vcard, txt, etc.), delete the offending
contacts, and import. Seems like there is no other way to fix the invalid
entrys or the address book.
 
G

genegiannamore

Can't figure out how to edit my prior post. I changed the little macro to
hopefully make a little more sense, I wonder if this new macro is ok, or will
it cause damage?
Option Explicit

Sub FixEntryIDs()
Call FixEntryID
End Sub

Sub FixEntryID(Optional ByVal contacts As folder)
Dim item As ContactItem
Dim subf As folder
Dim changed As Boolean

If IsMissing(contacts) Or contacts Is Nothing Then
Set contacts = ActiveExplorer.CurrentFolder
End If

For Each item In contacts.Items
if item is nothing then
debug.print "Skipped"
else
If item.Class = olContact Then
changed = False
If item.Email1Address = "" Then
item.Email1Address = "(e-mail address removed)"
changed = True
End If
If changed Then
Call item.Save
End If
If item.Email1Address = "(e-mail address removed)" Then
item.Email1Address = ""
changed = True
End If
If Len(item.Email1DisplayName) Then
item.Email1DisplayName = ""
changed = True
End If
If Len(item.Email2DisplayName) Then
item.Email2DisplayName = ""
changed = True
End If
If Len(item.Email3DisplayName) Then
item.Email3DisplayName = ""
changed = True
End If
If changed Then
Call item.Save
End If
End if
End If
Next

For Each subf In contacts.Folders
FixEntryID subf
Next
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

VBA Coding Help for Beginner 0
Macro to generate FileName of the source file 1
VBA Export to PDF 0
WORD VBA Search and switch to advanced ... 1
type mismatch error in macro in excel 0
Macro help 0
ItemChange Event to Propagate Contacts 1
export to access 1

Top