1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49
| Private Sub cmdCreateOutlookContact_Click()
Me.Dirty = False
Dim oAPP As Outlook.Application
Dim oContact As Outlook.ContactItem
Dim oMAPI 'As Outlook.MAPIFolder
Set oAPP = CreateObject("Outlook.Application")
Set oMAPI = oAPP.GetNamespace("MAPI")
oMAPI.Logon
Set oContact = oAPP.CreateItem(olContactItem)
oContact.Display
If Not IsNull(Me.Titre) Then
oContact.Title = Me.Titre
End If
oContact.LastName = Me.Nom
If Not IsNull(Me.Prénom) Then
oContact.FirstName = Me.Prénom
End If
If Not IsNull(Me.Société) Then
oContact.CompanyName = Me.Société
End If
If Not IsNull(Me.Email1) Then
oContact.Email1Address = Me.Email1
End If
If Not IsNull(Me.Code_postal__bureau_) Then
oContact.BusinessAddressPostalCode = Me.Code_postal__bureau_
End If
If Not IsNull(Me.Ville__bureau_) Then
oContact.BusinessAddressCity = Me.Ville__bureau_
End If
If Not IsNull(Me.Téléphone_bureau_) Then
oContact.BusinessTelephoneNumber = Me.Téléphone_bureau_
End If
If Not IsNull(Me.Télécopie_Bureau_) Then
oContact.BusinessFaxNumber = Me.Télécopie_Bureau_
End If
If Not IsNull(Me.Rue__bureau_) Then
oContact.BusinessAddressStreet = Me.Rue__bureau_
End If
If Not IsNull(Me.Job_Title) Then
oContact.JobTitle = Me.Fonction
End If
If Not IsNull(Me.Web_Page) Then
oContact.WebPage = Me.Web_Page
End If
oContact.Save
End Sub |
Partager