Exporteren van Excel naar Outlook

[Warme bakkertje]

Ik denk toch dat de aanhouder gaat winnen.

Sub ExcelWorksheetDataAddToOutlookContacts()

Dim ws As Worksheet, lLastRow As Long, i As Long, c00 As String, c01 As String

Set ws = Sheets("Clientgegevens")
lLastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row

For i = 2 To lLastRow
    With CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(10).Items
        c00 = ws.Cells(i, 1).Value & " " & ws.Cells(i, 2).Value
        For Each it In .Restrict("[FullName]='" & c00 & "'")
            c01 = it.FullName
        Next
    End With
    If c01 = vbNullString Then
        With CreateObject("Outlook.Application").CreateItem(2)
            .FirstName = ws.Cells(i, 1).Value
            .LastName = ws.Cells(i, 2).Value
            .Email1Address = ws.Cells(i, 3).Value
            .Email1DisplayName = ws.Cells(i, 4).Value
    '        .MobileTelephoneNumber = ws.Cells(i, 5).Value
    '        .HomeAddressStreet = ws.Cells(i, 6).Value
    '        .HomeAddressPostalCode = ws.Cells(i, 7).Value
    '        .HomeAddressCity = ws.Cells(i, 8).Value
    '        .Birthday = ws.Cells(i, 9).Value
            .Close 0
        End With
    Else
        c01 = vbNullString
    End If
Next
Set ws = Nothing

End Sub

 

[Ocirne]

Beste Rudi,

Het werkt !!!! Echt, geweldig. Hier ben ik heel blij mee. :thumb:

Ontzettend bedankt dat je zo aanhoudend bent geweest en bereid om er toch aardig wat tijd in te steken om het probleem boven tafel te krijgen. Echt super!

Mvg,

Ocirne