Link to home
Start Free TrialLog in
Avatar of rogerdjr
rogerdjrFlag for United States of America

asked on

Vba Code won't process Set olObject = ContFldr.Items.Find("[Email1Address] = " & .To) with email address that contains a period

Tying to run vba code sequence in Outlook to update contacts records based on sent ".to" email address it stalls on contacts with a "." in the first part (e.g. xxx.zzz@test.com) on this code line:

                        Set olObject = ContFldr.Items.Find("[Email1Address] = " & .To)

See attached image for the error message

Full code section is

Sub eBlastUpdateContact02User2BasedonEmailSentData()

    Dim mai As MailItem
    Dim UpdtCount As Integer, UpdtCount1 As Integer
    
    Dim oOlApp As Outlook.Application
    Dim objNmSpc As NameSpace
    Dim ofldr As Object
    Dim ContFldr As Object
    Dim UpdateUserFieldYN As Integer
    Dim ClearExistingUser2ContentYN As Integer
    
    Dim olObject As Object
    Dim olContact As Outlook.ContactItem
    
    Dim propertyAccessor As Outlook.propertyAccessor, SentDate As Date
    
    Dim BodyUpdate As Integer
            
    Set oOlApp = Outlook.Application
    Set objNmSpc = oOlApp.GetNamespace("MAPI")
    
    MsgBox "Select Email Folder - Sent Emails"
    Set ofldr = objNmSpc.PickFolder
    
    MsgBox "Select Contacts Folder"
    Set ContFldr = objNmSpc.PickFolder

    MsgBox "Email Folder for Sent Emails - " & ofldr.FolderPath & vbNewLine & ofldr & vbNewLine & "Contacts - " & ContFldr.FolderPath & vbNewLine & ContFldr
    
    BodyUpdate = MsgBox("Do You Want to Update the Contact Body?", vbYesNo) '2020-04-05
    
    UpdateUserFieldYN = MsgBox("This Process Upadates User2 Field - Do You Want to Proceed?", vbYesNo)
       
       If UpdateUserFieldYN = 6 Then

            ClearExistingUser2ContentYN = MsgBox("Do you want to clear existing User2 Content from all contacts", vbYesNo)
            
            If ClearExistingUser2ContentYN = 6 Then
                UpdtCount1 = 1
                For Each olObject In ContFldr.Items
                    If TypeName(olObject) = "ContactItem" Then
                        Set olContact = olObject
                        
                        olContact.User2 = ""
                        olContact.Save
                    End If
                            
                    UserForm1.TextBox1 = UpdtCount1
                    UserForm1.TextBox2 = "Contact " & UpdtCount1 & " " & olContact.FileAs
                    UserForm1.Show vbModeless
                    DoEvents
                            
                    UpdtCount1 = UpdtCount1 + 1
                Next
            End If

            UpdtCount = 1
        
            For Each mai In ofldr.Items
                
 'on error resume next
                If mai.Class = olMail Then
                    With mai
                        
                        Set propertyAccessor = mai.propertyAccessor
                        SentDate = Format(propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x0E060040"), "mm-dd-yyyy")
                        
                        Set olObject = ContFldr.Items.Find("[Email1Address] = " & .To)
                        
                        If TypeName(olObject) = "ContactItem" Then
                            olObject.User2 = "Sent " & SentDate & " " & .Subject
                            If BodyUpdate = 6 Then olObject.Body = "Introduction Email Sent " & SentDate & " " & .Subject & vbNewLine & "-----------------" & vbNewLine & olObject.Body ' 2020-04-06
'2020-04-05                            olObject.Save
                        End If
On Error Resume Next
                        UserForm1.TextBox1 = UpdtCount & "Email   " & " " & .Subject
                        UserForm1.TextBox2 = UpdtCount & "Contact " & " " & olObject.FileAs
                        UserForm1.Show vbModeless
                        DoEvents
                    End With
                End If
                            
                UpdtCount = UpdtCount + 1
            Next
        
        End If
        
        Unload UserForm1
        
        MsgBox "Macro Complete"

End Sub

Open in new window

run-time-error-440-cannot-parse-cond.JPG
SOLUTION
Avatar of David Bernstein
David Bernstein
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
ASKER CERTIFIED SOLUTION
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of rogerdjr

ASKER

THanks for the quick response - identical suggestions worked perfectly
Avatar of Bill Prew
Bill Prew

Welcome.


»bp