Copy Macro Help

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

Since Oulook 2003 cannot synchronize the public folder with a personal folder
I would like to create a macro to copy the public contacts folder (or all
entries within) to a new folder on my local contacts on a regular basis to
ensure the contacts are always up to date. The reason I need to do this is
because of a 3rd party communications application that will only recognise
locally stored personal conatcts.

Any help is appreciated.
 
By locally stored, do you mean available for offline use or stored in a .pst
file?

If the former, you can add the public Contacts folder to your Favorites
folder by right-clicking the folder and choose "Add to Favorites...". This
will make the folder available for offline use, and any changes you make
while disconnected from Exchange will get synchronized the next time you
connect.

For .pst folders, it is pretty easy to export the public Contacts folder to
a .pst file that you can then open as a separate store in Outlook, or import
into the default Contacts folder, by using the Import/Export Wizard. However,
this process cannot be automated.

To do this synchronization with the default Contacts folder automatically
(whether .ost or .pst), then this involves a fair amount of code. You
couldn't rely on using Windows Task Scheduler to do this, as Outlook
automation is not supported in this scenario. So you'd have to initiate this
process manually by launching a macro containing your Contacts copying code,
or have this fired by certain Outlook events (like starting Outlook, during a
Send/Receive cycle, etc.).

If you need this synchronization to occur automatically 24/7 without
requiring Outlook to be open, then the solution can be built with an Exchange
Event Sink. This is a custom .dll designed with VB6/C++/.NET that can be
registred in the public Contacts folder, and everytime a Contact item is
added, deleted, or changed, the code can do the same thing for a Contact
folder stored in any user's Exchange mailbox that you specify (all or a
smaller list).

So there's lots of options, depending on what you need!
 
Thanks for your detailed reply.

Perhaps I'm not explaining my problem very well. The problem I have got is
this:

1) The 3rd party application my company uses will only scan the personal
contacts folder (eg. labelled contacts in outlook 2003)
2) All clients use the public address book for all contact information, can
edit/delete/add conatcts and we therefore have to keep manually copying the
public contacts folder into the personal contacts folder everytime a change
is made.
3) I am looking for automated method. eg. everytime outlook is launched on a
client machine or a macro button is clicked, the most up to date public
address book is copied into the personal contacts.

All the computers are permanently connected to exchange and would not
require to view information if offline.

look 2003 cannot synchronize the public folder with a personal folder
 
Yes, that is exactly how I interpret your problem.

If you need to have the Contacts in the Public Folder copied to the local
Contacts folder automatically on Outlook startup, this can definitely be
done. However, the code would have to compare a small to large amount of
Contact properties between the two folders to determine whether a copy exists
already, otherwise duplicates would be constanty created if you just called
the ContactItem.Copy method. Not to worry though, as the FileAs or FullName
properties could generally be used to compare a pair of Contacts.

Anyway, below is a draft of some code that could do what you need. For more
information on distributing macros, see:

Visual Basic and VBA Coding in Microsoft Outlook:
http://www.outlookcode.com/d/vb.htm

If you want to run this automatically on startup, providing you know the
unique EntryID and StoreID properties of the Public Contacts Folder that you
are copying from, then call the SynchronizeContacts procedure in the
Application_Startup event; otherwise create a custom toolbar button to launch
the SynchronizeContacts macro on demand.

Private Sub Application_Startup()
SynchronizeContacts
End Sub

Sub SynchronizeContacts()
On Error Resume Next

Dim objNS As Outlook.NameSpace
Dim objPublicContactsFolder As Outlook.MAPIFolder
Dim objPrivateContactsFolder As Outlook.MAPIFolder

Set objNS = Application.GetNamespace("MAPI")

'Get a handle to the local Contacts folder
'Set objPrivateContactsFolder =
Application.GetNamespace("MAPI").GetDefaultFolder(olFolderContacts).Items
'Or choose the folder manually
Set objPrivateContactsFolder = objNS.PickFolder

'You need to pass the EntryID and StoreID values of the Public Contact
Folder
'that appointments will be copied to as arguments to the GetFolderFromID
'Set objPublicContactsFolder = objNS.GetFolderFromID("", "")
'Or choose the folder manually
Set objPublicContactsFolder = objNS.PickFolder

CopyContactsBetweenFolders objPublicContactsFolder,
objPrivateContactsFolder

Set objPrivateContactsFolder = Nothing
Set objPublicContactsFolder = Nothing
End Sub

Sub CopyContactsBetweenFolders(SourceFolder As Outlook.MAPIFolder,
DestinationFolder As Outlook.MAPIFolder)
On Error GoTo CopyContactsBetweenFolders_Error

Dim objItem As Object, objItems As Outlook.Items
Dim objSourceItem As Outlook.ContactItem
Dim objDestinationItems As Outlook.Items, objDestinationItem As
Outlook.ContactItem
Dim objNewItem As Outlook.ContactItem

If SourceFolder.DefaultItemType <> olContactItem Or
DestinationFolder.DefaultItemType <> olContactItem Then
MsgBox "You must specify a Contacts folder.", vbOKOnly +
vbExclamation, "Invalid Folder"
Exit Sub
End If

For Each objItem In SourceFolder.Items
If objItem.Class <> olDistributionList Then
Set objSourceItem = objItem
Set objItems = DestinationFolder.Items
Set objDestinationItems = objItems.Restrict("[FullName] = '" &
objSourceItem.FullName & "'")
If objDestinationItems.Count = 0 Then
'Contact doesn't exist, copy
Set objNewItem = objSourceItem.Copy
objNewItem.Move DestinationFolder
Else
'Contact exists; delete and copy
If objDestinationItems.Count > 1 Then
'Multiple copies! Delete them all?
Else
Set objDestinationItem = objDestinationItems.Item(1)
objDestinationItem.Delete
Set objNewItem = objSourceItem.Copy
objNewItem.Move DestinationFolder
End If
End If
End If
Next

Set objItem = Nothing
Set objItems = Nothing
Set objSourceItem = Nothing
Set objDestinationItem = Nothing
Set objDestinationItems = Nothing
Set objNewItem = Nothing

On Error GoTo 0
Exit Sub

CopyContactsBetweenFolders_Error:
If Err.Number <> 0 Then
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in
procedure CopyContactsBetweenFolders of Class Module clsCopyContacts"
Resume Next
End If
End Sub
 
That code did not work. I ended up with lots more entries despite deleting
just 1 entry from the public folder.

Would it be easier to just delete my personal folder called COMPANYDIR that
is located under the contacts folder and then copy the public folder called
COMPANY GLOBALDIR to that location.

i.e code to automatically select folder and delete


Eric Legault said:
Yes, that is exactly how I interpret your problem.

If you need to have the Contacts in the Public Folder copied to the local
Contacts folder automatically on Outlook startup, this can definitely be
done. However, the code would have to compare a small to large amount of
Contact properties between the two folders to determine whether a copy exists
already, otherwise duplicates would be constanty created if you just called
the ContactItem.Copy method. Not to worry though, as the FileAs or FullName
properties could generally be used to compare a pair of Contacts.

Anyway, below is a draft of some code that could do what you need. For more
information on distributing macros, see:

Visual Basic and VBA Coding in Microsoft Outlook:
http://www.outlookcode.com/d/vb.htm

If you want to run this automatically on startup, providing you know the
unique EntryID and StoreID properties of the Public Contacts Folder that you
are copying from, then call the SynchronizeContacts procedure in the
Application_Startup event; otherwise create a custom toolbar button to launch
the SynchronizeContacts macro on demand.

Private Sub Application_Startup()
SynchronizeContacts
End Sub

Sub SynchronizeContacts()
On Error Resume Next

Dim objNS As Outlook.NameSpace
Dim objPublicContactsFolder As Outlook.MAPIFolder
Dim objPrivateContactsFolder As Outlook.MAPIFolder

Set objNS = Application.GetNamespace("MAPI")

'Get a handle to the local Contacts folder
'Set objPrivateContactsFolder =
Application.GetNamespace("MAPI").GetDefaultFolder(olFolderContacts).Items
'Or choose the folder manually
Set objPrivateContactsFolder = objNS.PickFolder

'You need to pass the EntryID and StoreID values of the Public Contact
Folder
'that appointments will be copied to as arguments to the GetFolderFromID
'Set objPublicContactsFolder = objNS.GetFolderFromID("", "")
'Or choose the folder manually
Set objPublicContactsFolder = objNS.PickFolder

CopyContactsBetweenFolders objPublicContactsFolder,
objPrivateContactsFolder

Set objPrivateContactsFolder = Nothing
Set objPublicContactsFolder = Nothing
End Sub

Sub CopyContactsBetweenFolders(SourceFolder As Outlook.MAPIFolder,
DestinationFolder As Outlook.MAPIFolder)
On Error GoTo CopyContactsBetweenFolders_Error

Dim objItem As Object, objItems As Outlook.Items
Dim objSourceItem As Outlook.ContactItem
Dim objDestinationItems As Outlook.Items, objDestinationItem As
Outlook.ContactItem
Dim objNewItem As Outlook.ContactItem

If SourceFolder.DefaultItemType <> olContactItem Or
DestinationFolder.DefaultItemType <> olContactItem Then
MsgBox "You must specify a Contacts folder.", vbOKOnly +
vbExclamation, "Invalid Folder"
Exit Sub
End If

For Each objItem In SourceFolder.Items
If objItem.Class <> olDistributionList Then
Set objSourceItem = objItem
Set objItems = DestinationFolder.Items
Set objDestinationItems = objItems.Restrict("[FullName] = '" &
objSourceItem.FullName & "'")
If objDestinationItems.Count = 0 Then
'Contact doesn't exist, copy
Set objNewItem = objSourceItem.Copy
objNewItem.Move DestinationFolder
Else
'Contact exists; delete and copy
If objDestinationItems.Count > 1 Then
'Multiple copies! Delete them all?
Else
Set objDestinationItem = objDestinationItems.Item(1)
objDestinationItem.Delete
Set objNewItem = objSourceItem.Copy
objNewItem.Move DestinationFolder
End If
End If
End If
Next

Set objItem = Nothing
Set objItems = Nothing
Set objSourceItem = Nothing
Set objDestinationItem = Nothing
Set objDestinationItems = Nothing
Set objNewItem = Nothing

On Error GoTo 0
Exit Sub

CopyContactsBetweenFolders_Error:
If Err.Number <> 0 Then
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in
procedure CopyContactsBetweenFolders of Class Module clsCopyContacts"
Resume Next
End If
End Sub


--
Eric Legault - B.A, MCP, MCSD, Outlook MVP
Try Picture Attachments Wizard for Outlook! http://tinyurl.com/9bby8
Job: http://www.imaginets.com
Blog: http://blogs.officezealot.com/legault/


Steve said:
Thanks for your detailed reply.

Perhaps I'm not explaining my problem very well. The problem I have got is
this:

1) The 3rd party application my company uses will only scan the personal
contacts folder (eg. labelled contacts in outlook 2003)
2) All clients use the public address book for all contact information, can
edit/delete/add conatcts and we therefore have to keep manually copying the
public contacts folder into the personal contacts folder everytime a change
is made.
3) I am looking for automated method. eg. everytime outlook is launched on a
client machine or a macro button is clicked, the most up to date public
address book is copied into the personal contacts.

All the computers are permanently connected to exchange and would not
require to view information if offline.

look 2003 cannot synchronize the public folder with a personal folder
Click to expand...
Click to expand...
 
What exactly doesn't work? The code I provided was certainly not meant to be
a complete solution for your needs, but a framework and an example that you
can take to customize so that it does exactly what you want.

Note that I only included some basic logic to determine what a duplicate
Contact might be - you may have to compare multiple properties to satisfy a
"perfect" match. Again, customize so that it does what you need.

You can certainly change the code so that it synchronizes a folder - rather
than the contents - by deleting the destination and copying the source.
However, you will lose any published form definitions and custom views if you
do this with code. That information can only be copied by using the
Import/Export Wizard or the "Copy Folder Design" action, neither of which can
be programmed.

--
Eric Legault - B.A, MCP, MCSD, Outlook MVP
Try Picture Attachments Wizard for Outlook! http://tinyurl.com/9bby8
Job: http://www.imaginets.com
Blog: http://blogs.officezealot.com/legault/


Steve said:
That code did not work. I ended up with lots more entries despite deleting
just 1 entry from the public folder.

Would it be easier to just delete my personal folder called COMPANYDIR that
is located under the contacts folder and then copy the public folder called
COMPANY GLOBALDIR to that location.

i.e code to automatically select folder and delete


Eric Legault said:
Yes, that is exactly how I interpret your problem.

If you need to have the Contacts in the Public Folder copied to the local
Contacts folder automatically on Outlook startup, this can definitely be
done. However, the code would have to compare a small to large amount of
Contact properties between the two folders to determine whether a copy exists
already, otherwise duplicates would be constanty created if you just called
the ContactItem.Copy method. Not to worry though, as the FileAs or FullName
properties could generally be used to compare a pair of Contacts.

Anyway, below is a draft of some code that could do what you need. For more
information on distributing macros, see:

Visual Basic and VBA Coding in Microsoft Outlook:
http://www.outlookcode.com/d/vb.htm

If you want to run this automatically on startup, providing you know the
unique EntryID and StoreID properties of the Public Contacts Folder that you
are copying from, then call the SynchronizeContacts procedure in the
Application_Startup event; otherwise create a custom toolbar button to launch
the SynchronizeContacts macro on demand.

Private Sub Application_Startup()
SynchronizeContacts
End Sub

Sub SynchronizeContacts()
On Error Resume Next

Dim objNS As Outlook.NameSpace
Dim objPublicContactsFolder As Outlook.MAPIFolder
Dim objPrivateContactsFolder As Outlook.MAPIFolder

Set objNS = Application.GetNamespace("MAPI")

'Get a handle to the local Contacts folder
'Set objPrivateContactsFolder =
Application.GetNamespace("MAPI").GetDefaultFolder(olFolderContacts).Items
'Or choose the folder manually
Set objPrivateContactsFolder = objNS.PickFolder

'You need to pass the EntryID and StoreID values of the Public Contact
Folder
'that appointments will be copied to as arguments to the GetFolderFromID
'Set objPublicContactsFolder = objNS.GetFolderFromID("", "")
'Or choose the folder manually
Set objPublicContactsFolder = objNS.PickFolder

CopyContactsBetweenFolders objPublicContactsFolder,
objPrivateContactsFolder

Set objPrivateContactsFolder = Nothing
Set objPublicContactsFolder = Nothing
End Sub

Sub CopyContactsBetweenFolders(SourceFolder As Outlook.MAPIFolder,
DestinationFolder As Outlook.MAPIFolder)
On Error GoTo CopyContactsBetweenFolders_Error

Dim objItem As Object, objItems As Outlook.Items
Dim objSourceItem As Outlook.ContactItem
Dim objDestinationItems As Outlook.Items, objDestinationItem As
Outlook.ContactItem
Dim objNewItem As Outlook.ContactItem

If SourceFolder.DefaultItemType <> olContactItem Or
DestinationFolder.DefaultItemType <> olContactItem Then
MsgBox "You must specify a Contacts folder.", vbOKOnly +
vbExclamation, "Invalid Folder"
Exit Sub
End If

For Each objItem In SourceFolder.Items
If objItem.Class <> olDistributionList Then
Set objSourceItem = objItem
Set objItems = DestinationFolder.Items
Set objDestinationItems = objItems.Restrict("[FullName] = '" &
objSourceItem.FullName & "'")
If objDestinationItems.Count = 0 Then
'Contact doesn't exist, copy
Set objNewItem = objSourceItem.Copy
objNewItem.Move DestinationFolder
Else
'Contact exists; delete and copy
If objDestinationItems.Count > 1 Then
'Multiple copies! Delete them all?
Else
Set objDestinationItem = objDestinationItems.Item(1)
objDestinationItem.Delete
Set objNewItem = objSourceItem.Copy
objNewItem.Move DestinationFolder
End If
End If
End If
Next

Set objItem = Nothing
Set objItems = Nothing
Set objSourceItem = Nothing
Set objDestinationItem = Nothing
Set objDestinationItems = Nothing
Set objNewItem = Nothing

On Error GoTo 0
Exit Sub

CopyContactsBetweenFolders_Error:
If Err.Number <> 0 Then
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in
procedure CopyContactsBetweenFolders of Class Module clsCopyContacts"
Resume Next
End If
End Sub


--
Eric Legault - B.A, MCP, MCSD, Outlook MVP
Try Picture Attachments Wizard for Outlook! http://tinyurl.com/9bby8
Job: http://www.imaginets.com
Blog: http://blogs.officezealot.com/legault/


Steve said:
Thanks for your detailed reply.

Perhaps I'm not explaining my problem very well. The problem I have got is
this:

1) The 3rd party application my company uses will only scan the personal
contacts folder (eg. labelled contacts in outlook 2003)
2) All clients use the public address book for all contact information, can
edit/delete/add conatcts and we therefore have to keep manually copying the
public contacts folder into the personal contacts folder everytime a change
is made.
3) I am looking for automated method. eg. everytime outlook is launched on a
client machine or a macro button is clicked, the most up to date public
address book is copied into the personal contacts.

All the computers are permanently connected to exchange and would not
require to view information if offline.

look 2003 cannot synchronize the public folder with a personal folder
I would like to create a macro to copy the public contacts folder (or all
entries within) to a new folder on my local contacts on a regular basis to
ensure the contacts are always up to date. The reason I need to do this is
because of a 3rd party communications application that will only recognise
locally stored personal conatcts.

Any help is appreciated.
Click to expand...
Click to expand...
Click to expand...
 
Back
Top