Aide correction code

[Lone-wolf]

Bonjour à tous ! 🙂


J'ai créé un nouveau dossier dans Contacts-Outlook nommé Liste
Pourriez-vous m'aider à corriger le code pour les inserer automatiquement dans Outlook?

Private Sub Nouveau_Click()
    Dim objOutlook As Outlook.Application
    Dim objContact As ContactItem
    Dim Ligne As String 
    
    Set objOutlook = New Outlook.Application
    Set objContact = objOutlook.CreateItem(olContactItem)

     UserForm1.TextBox10.Value = Sheets(1).Range("A65535").End(xlUp).Row + 1
     Ligne = UserForm1.TextBox10.Value
     If Ligne = "" Then MsgBox "Faites une recherche " & vbLf & "Ou faites un          nouvelle saisie ": Exit Sub
     For i = 1 To 8
        Sheets(1).Cells(Ligne, i).Value = UserForm1.Controls("textbox" & i).Value
    Next	
  
    With objContact
        .Email1Address = TextBox6.Value
        .FullName = TextBox1.Value
	.HomeAddressCity = TextBox2.Value
	.HomeAreaCode = TextBox3.Value     'Est-ce bien le code postal? J'ai vu sur Google plusieurs noms
	.HomeCity = TextBox4.Value
        .HomeTelephoneNumber = TextBox5.Value
        .HomePageWeb = TextBox7.Value     
        .Save	
    End With
End Sub

 

[Lone-wolf]

Re : Aide correction code

Bonsoir à tous,

j'ai réussi à intégrer le code pour la création d'une liste de contact dans Outlook.

Les Intitulés doivent être les même que ceux d'Outlook.

Définissez un nom pour la liste en sélectionnant ceux-ci avec les cellules vides (de A1: I100 par ex.)

Pourquoi les mêmes intitulés? Les adresses seront automatiquement mises en place par Outlook.

Source 01.Net-Télécharger.com

Si ça peux servir...:

Private Sub Nouveau_Click()
    Dim Ligne As String
    UserForm1.TextBox10.Value = Sheets(1).Range("A65535").End(xlUp).Row + 1 'Textbox10 = numéro de la ligne
        Ligne = UserForm1.TextBox10.Value
        If Ligne = "" Then
        MsgBox "Veuillez saisir le contact", , "Nouveaux contacts": Exit Sub
        End If
    For i = 1 To 8
        Sheets(1).Cells(Ligne, i).Value = UserForm1.Controls("textbox" & i).Value
    Next
   TextBox8.SetFocus 'TextBox 8 = Titre

    'Insertion des contacts dans Outlook
    Dim objOutlook As Outlook.Application
    Dim objContact As ContactItem
    Set objOutlook = New Outlook.Application
    Set objContact = objOutlook.CreateItem(olContactItem)
    With objContact
        .FullName = Sheets(1).Range("A65535").End(xlUp).Value
        .BusinessTelephoneNumber = Sheets(1).Range("B65535").End(xlUp).Value
        .BusinessAddressStreet = Sheets(1).Range("C65535").End(xlUp).Value
        .BusinessAddressPostalCode = Sheets(1).Range("D65535").End(xlUp).Value
        .BusinessAddressCity = Sheets(1).Range("E65535").End(xlUp).Value
        .Email1Address = Sheets(1).Range("F65535").End(xlUp).Value
        .Save
    End With
End Sub

Bien entendu il faudra l'adapter à vos besoin.