I get the error when I run the macro through the Tools menu in Outlook. When
I enter the VB Editor and run it from there and choose the Contacts section
when the window pops up, it gives me an hourglass for a few minutes so it
appears to be doing something. However, none of the links appear to have
been fixed because of it. So I don't know if there is a problem or not or if
the program can't fix it.

When I do get the error it doesn't highlight anything to tell me what the
problem is, so I can't tell you. And I get no error when I try to debug.

Bryan

"Sue Mosher [MVP-Outlook]" wrote:

What statement gives you that error?

--
Sue Mosher, Outlook MVP
Author of Configuring Microsoft Outlook 2003
http://www.turtleflock.com/olconfig/index.htm
and Microsoft Outlook Programming - Jumpstart for
Administrators, Power Users, and Developers
http://www.outlookcode.com/jumpstart.aspx

"chunnel" wrote in message ...
I have tried what you mentioned but am still getting "Sub or Function not
defined". I hate to cut and paste the whole thing, but can you see an error
with what I've written?

Sub ReconnectLinks()
Dim objApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim objFolder As Outlook.MAPIFolder
Dim colItems As Outlook.Items
Dim objItem As Object
Dim colLinks As Outlook.Links
Dim objLink As Outlook.Link
Dim colContacts As Outlook.Items
Dim objContact As Outlook.ContactItem
Dim strFind As String
Dim intCount As Integer
Dim I As Integer
Set objApp = CreateObject("Outlook.Application")
Set objNS = objApp.GetNamespace("MAPI")
Set objFolder = objNS.PickFolder
If TypeName(objFolder) "Nothing" Then
Set colContacts = _
objNS.GetDefaultFolder(olFolderContacts).Items
Set colItems = objFolder.Items
For Each objItem In colItems
Set colLinks = objItem.Links
intCount = colLinks.Count
If intCount 0 Then
For I = intCount To 1 Step -1
Set objLink = colLinks.Item(I)
On Error Resume Next
If objLink.Item Is Nothing Then
strFind = "[FullName] = " & Quote(objLink.Name)
Set objContact = colContacts.Find(strFind)
If Not objContact Is Nothing Then
colLinks.Remove I
colLinks.Add objContact
End If
End If
Next
If Not objItem.Saved Then
objItem.Save
End If
End If
Next
End If

Set colContacts = Nothing
Set objContacts = Nothing
Set objLink = Nothing
Set colLinks = Nothing
Set objItem = Nothing
Set objItems = Nothing
Set objFolder = Nothing
Set objNS = Nothing
Set objApp = Nothing
End Sub
Private Function Quote(varInput)
Quote = Chr(34) & varInput & Chr(34)
End Function







"Sue Mosher [MVP-Outlook]" wrote:

The underscore is a continuation character. If you put the entire statement on one line, you must take the underscore out. If you leave it in, the quotation mark needs to be after the equals sign.


"chunnel" wrote in message ...
I tried the ReconnectLinks () from Listing 20.2 and I keep getting an error
at the line which is as follows;
If objLink.item Is Nothing Then
strFind = "[FullName] = _
" & Quote(objLink.Name)

If I type it as written then I get an compile error for unexpected end of
statement because I hit return after the "_". If it keep the 3rd line as
part of the 2nd line so that it looks as follows;
strFind = "[FullName] = _" & Quote(objLink.Name)
then I get an error when running it that Sub or Function is not defined and
it focuses on this line.