Outlook macro abends but Word macro runs successfully
I have created a macro for copying 140 contactitems. The macro was created
under Outlook 2003 (Vbaoject.OTM). When I run this macro, it successfully
copies around 125 rows and then abends. The Err.Description contains
"Automation Error, Unspecified Error". Then I run the same macro in the
debugger and set a breakpoint at the copy of row 125 to capture the error,
everything works fine and it continues to copy all 140 contactitems. As
another test, I created the exact same macro under a Word document and it
runs to completion. The code follows:
Option Explicit
Private ol As Object
Private olns As Object
Private AllItems As Object
Private Itm As Object
Private Sub CopyToButton_Click()
Dim myItem As Object
Dim i As Integer
Dim projectNameFrom, projectNameTo As String
On Error Resume Next
Set ol = New Outlook.Application
Set olns = ol.GetNamespace("MAPI")
projectNameFrom = "James Test 5"
projectNameTo = "James Test 1"
i = 0
Set AllItems = olns.GetDefaultFolder(18).Folders("TBS
Applications").Folders("CRM").Folders("Event
Contacts").Items.Restrict("[Event Name] = """ & projectNameFrom & """")
For Each Itm In AllItems
i = i + 1
Set myItem = olns.GetDefaultFolder(18).Folders("TBS
Applications").Folders("CRM").Folders("Event Contacts").Items.Add
myItem.UserProperties.Find("Event Name") = projectNameTo
myItem.JobTitle = Itm.JobTitle
myItem.FullName = Itm.FullName
myItem.CompanyName = Itm.CompanyName
myItem.Email1Address = Itm.Email1Address
myItem.BusinessTelephoneNumber = Itm.BusinessTelephoneNumber
myItem.UserProperties.Find("Participation Status").Value = "Invited"
myItem.Save
If Err Then
MsgBox "failed on row: " + i
MsgBox Err.Description
Exit Sub
End If
Next
MsgBox "Done"
Set ol = Nothing
Set olns = Nothing
Set myItem = Nothing
Set AllItems = Nothing
Set Itm = Nothing
End Sub
The contactitems being copied are associated with a custom form.
Any ideas?
--
James
|