Add contact to Outlook VBA

[Neilster]

Help please guy's!

Can anyone one work out why I'm getting 'Compile error' Type Mismatch

on this line "MsgBox "Error: " & Err & " " & Error"

I'm trying to set up a command button that adds to Outlook on my form.

Public Function fncAddToOutlook()
On Error GoTo StartError

Dim objOutlook As Outlook.Application
Dim objItem As Object

Set objOutlook = CreateObject("Outlook.Application")
Set objItem = objOutlook.CreateItem(olContactItem)

With objItem
.FullName = [ContactName]
.Email1Address = [Email1AddressOne]
.CompanyName = [CompanyName]
.BusinessAddress = [1stLineOfAddress]
.BusinessAddressCity = [City]
.BusinessAddressPostalCode = [PostCode]
.BusinessTelephoneNumber = [PhoneNumber 1]
.MobileTelephoneNumber = [Mobile]
.Categories = [EmployeeName]
End With

objItem.Display


Set objOutlook = Nothing

Exit Function

StartError:
MsgBox "Error: " & Err & " " & Error
Exit Function
End Function

 

[Trevor G]

Adapt this function and it should work.

Function AddOutlookContact()
On Error GoTo Error_Handler
Const olContactItem = 2
Dim olApp As Object
Dim Ctct As Object, olContact As Object

Set olApp = CreateObject("Outlook.Application")
Set olContact = olApp.CreateItem(olContactItem)

With olContact
.FirstName = "John"
.LastName = "Smith"
.JobTitle = "Database Designer"
.CompanyName = "Access Developer"
.BusinessAddressStreet = "123 High Street"
.BusinessAddressCity = "Town Name"
.BusinessAddressState = "North"
.BusinessAddressCountry = "UK"
.BusinessAddressPostalCode = "111111"
.BusinessTelephoneNumber = "01234"
.BusinessFaxNumber = "012345"
.Email1Address = "john.smith@accessdeveloper.co.uk"
.MobileTelephoneNumber = "01234566"
.Save 'use .Display if you wish the user to see the contact pop-up
End With

Error_Handler_Exit:
On Error Resume Next
Set olContact = Nothing
Set olApp = Nothing
Exit Function

Error_Handler:
MsgBox "MS Access has generated the following error" & vbCrLf & vbCrLf & "Error Number: " & _
Err.Number & vbCrLf & "Error Source: AddOlContact" & vbCrLf & "Error Description: " & _
Err.Description, vbCritical, "An Error has Occured!"
Resume Error_Handler_Exit
End Function

 

[Neilster]

Thanks Trevor!

This works a treat, however is there away as I'm sure that when the button is clicked it would pick up the recordset? .......as in open up with the details of the customer related to what's on that form page and so on

Kind regards (-:

 

[Trevor G]

Can you add a stripped down copy of your database to your thread then I will take a look.

 

[Neilster]

The company are a bit sensitive about that I'm afraid sorry.

It's just I have a table called TblCustomerDetails with standard cells, ContactName, Address, postcode, phone number etc.

All I need is to extract that data and insert into the fields, I have tried....

With olContact
.FirstName = [ContactName]
.EmailAdress = [EmailAdressOne]

and

With olContact
.FirstName = me.ContactName
.EmailAdress = me.EmailAdressOne

But its jus not working. Hopefully you could shed some light on the problem.

Kind regards,

 

[Trevor G]

Take a look at the attached. The code is behind the button on the form. The database isn't attached (slight issue), the code is shown below it is behind a command button on the form.

Private Sub cmdOutlookContact_Click()
On Error GoTo StartError
Dim objOutlook As Outlook.Application
Dim objItem As Object
Set objOutlook = CreateObject("Outlook.Application")
Set objItem = objOutlook.CreateItem(olContactItem)
With objItem
.FullName = Me.ContactName
.Email1Address = Me.Email1AddressOne
.CompanyName = CompanyName
.BusinessAddress = Me.LineOfAddress1st
.BusinessAddressCity = City
.BusinessAddressPostalCode = PostCode
.BusinessTelephoneNumber = PhoneNumber_1
.MobileTelephoneNumber = Mobile
.Categories = EmployeeName
End With
objItem.Display

Set objOutlook = Nothing
Exit Sub
StartError:
MsgBox "Error: " & Err & " " & Error
Exit Sub
End Sub

 

[Neilster]

Yeh still getting

'Compile error' Type Mismatch

on this line

"MsgBox "Error: " & Err & " " & Error"

 

[arnelgp]

MsgBox "Error: " & Err.Number & " " & Err.Description

 

[Neilster]

Now I get this, I've tried to research it

error:-2147417851 Method 'FullName' of object'_ contactitem' failed

 

[Trevor G]

Attached is the sample database. Look at the form in design view select the button and open the properties select the On Click Event.

 

[Neilster]

Thanks for that Trevor, however even when I use your form click on the button I still get this message.

error:-2147417851 Method 'FullName' of object'_ contactitem' failed

 

[Trevor G]

Although its not referenced in VBA select the Tools Menu and References and search down for Microsoft Outlook XX . Object Library XX being the version number and click the option. Test the code again.

 

[Neilster]

Thanks for all your help Trevor, this code I wrote seems to work just fine.

Dim myOutlook As Outlook.Application
Dim myItems As ContactItem

Set myOutlook = CreateObject("Outlook.Application")
Set myItems = myOutlook.CreateItem(olContactItem)

With myItems
.FirstName = Me.ContactName
.JobTitle = Me.ContactPosition
.CompanyName = Me.CompanyName
.BusinessAddressStreet = Me.[1stLineOfAddress]
.BusinessAddressCity = Me.City
'.BusinessAddressState = "North"
.BusinessAddressCountry = "UK"
.BusinessAddressPostalCode = Me.PostCode
.BusinessTelephoneNumber = Me.txtPhoneNumber_1
.MobileTelephoneNumber = Me.Mobile
.Email1Address = Me.EmailAddressOne

.Save
.Display

I just need to work out IfNull bit of programming, I have tried..

If IsNull(Me.ContactName) Or Me.ContactName = "" Then
MsgBox "You must enter a Company Name.", vbOKOnly, "Access"
Exit Sub

End If

But it's not working right??/

 

[Trevor G]

Look to adapt this as I have tested and it works fine.

On Error GoTo StartError
Dim objOutlook As Outlook.Application
Dim objItem As Object
Set objOutlook = CreateObject("Outlook.Application")
Set objItem = objOutlook.CreateItem(olContactItem)
If IsNull(ContactName) Then
MsgBox "You must enter a Company Name.", vbOKOnly, "Access"
Exit Sub
ElseIf ContactName <> "" Then

With objItem
.FullName = Me.ContactName
.Email1Address = Me.Email1AddressOne
.CompanyName = CompanyName
.BusinessAddress = Me.LineOfAddress1st
.BusinessAddressCity = City
.BusinessAddressPostalCode = PostCode
.BusinessTelephoneNumber = PhoneNumber_1
.MobileTelephoneNumber = Mobile
.Categories = EmployeeName
End With
objItem.Display

Set objOutlook = Nothing
Exit Sub
End If

StartError:
MsgBox "Error: " & Err & " " & Error
Exit Sub

 

[Neilster]

The only code I can get to work is this

If IsNull(ContactName) Then
MsgBox "You must enter a Contact Name.", vbOKOnly, "Access"
Exit Sub
ElseIf ContactName <> "" Then

With myItems

.FirstName = Me.ContactName
.JobTitle = Me.ContactPosition
.CompanyName = Me.CompanyName
.BusinessAddressStreet = Me.[1stLineOfAddress]
.BusinessAddressCity = Me.City
'.BusinessAddressState = "North"
.BusinessAddressCountry = "UK"
.BusinessAddressPostalCode = Me.PostCode
.BusinessTelephoneNumber = Me.txtPhoneNumber_1
.MobileTelephoneNumber = Me.Mobile
.Email1Address = Me.EmailAddressOne

.Save
.Display

And when the msgbox comes up regarding 'you must add a contact name' after you OK it the come up with the debug form 'Invalid us of null'

I tried your code above and it comes up with loads of errors then crashes.

Or am I just missing something....