Userform vult geen gegevens aan in outlook

Sub ExcelWorksheetDataAddToOutlookContacts3()
'Automating Outlook from Excel: This example uses the Items.Add Method to export data from an Excel Worksheet to the default Contacts folder.
'Automate Outlook from Excel, using Late Binding. You need not add a reference to the Outlook library in Excel (your host application), in this case you will not be able to use the Outlook's predefined constants and will need to replace them by their numerical values in your code.


'Ensure that the worksheet data to be posted to Outlook, starts from row number 2:

'Ensure corresponding columns of data in the Worksheet, as they will be posted in the Outlook Contacts Folder:
'Column A: First Name
'Column B: Last Name
'Column C: Email Address
'Column D: Company Name
'Column E: Mobile Telephone Number

Dim oApplOutlook As Object
Dim oNsOutlook As Object
Dim oCFolder As Object
Dim oDelFolder As Object
Dim oCItem As Object
Dim oDelItems As Object
Dim lLastRow As Long, i As Long, n As Long, c As Long

'determine last data row in the worksheet:
lLastRow = Sheets("Blad1").Cells(Rows.Count, "A").End(xlUp).Row
 
'Create a new instance of the Outlook application, if an existing Outlook object is not available.
'Set the Application object as follows:
On Error Resume Next
Set oApplOutlook = GetObject(, "Outlook.Application")
'if an instance of an existing Outlook object is not available, an error will occur (Err.Number = 0 means no error):
If Err.Number <> 0 Then

Set oApplOutlook = CreateObject("Outlook.Application")

End If
'disable error handling:
On Error GoTo 0

'use the GetNameSpace method to instantiate (ie. create an instance) a NameSpace object variable, to access existing Outlook items. Set the NameSpace object as follows:
Set oNsOutlook = oApplOutlook.GetNamespace("MAPI")

'----------------------------

'Empty the Deleted Items folder in Outlook so that when you quit the Outlook application you bypass the prompt: Are you sure you want to permanently delete all the items and subfolders in the "Deleted Items" folder?

'set the default Deleted Items folder:
'The numerical value of olFolderDeletedItems is 3. The following code has replaced the Outlook's built-in constant olFolderDeletedItems by its numerical value 3.
Set oDelFolder = oNsOutlook.GetDefaultFolder(3)
'set the items collection:
Set oDelItems = oDelFolder.Items

'determine number of items in the collection:
c = oDelItems.Count
'start deleting from the last item:
For n = c To 1 Step -1

oDelItems(n).Delete

Next n

'----------------------------

'set reference to the default Contact Items folder:
'The numerical value of olFolderContacts is 10. The following code has replaced the Outlook's built-in constant olFolderContacts by its numerical value 10.
Set oCFolder = oNsOutlook.GetDefaultFolder(10)

'post each row's data on a separate contact item form:
For i = 2 To lLastRow

'Using the Items.Add Method to create a new Outlook contact item in the default Contacts folder.
Set oCItem = oCFolder.Items.Add
'display the new contact item form:
oCItem.Display
'set properties of the new contact item:
With oCItem

.FirstName = UserForm2.TextBox1.Value
.MiddleName = UserForm2.TextBox2.Value
.LastName = UserForm2.TextBox3.Value
.Email1Address = UserForm2.TextBox4.Value
.MobileTelephoneNumber = UserForm2.TextBox5.Value
.HomeTelephoneNumber = UserForm2.TextBox6.Value
.BusinessTelephoneNumber = UserForm2.TextBox7.Value
.BusinessAddressStreet = UserForm2.TextBox8.Value
.BusinessAddressPostalCode = UserForm2.TextBox9.Value
.BusinessAddressCity = UserForm2.TextBox10.Value




End With
'close the new contact item form after saving:
'The numerical value of olSave is 0. The following code has replaced the Outlook's built-in constant olSave by its numerical value 0.
oCItem.Close 0

Next i

'quit the Oulook application:
oApplOutlook.Quit

'clear the variables:
Set oApplOutlook = Nothing
Set oNsOutlook = Nothing
Set oCFolder = Nothing
Set oDelFolder = Nothing
Set oCItem = Nothing
Set oDelItems = Nothing

MsgBox "Successfully Exported Worksheet Data to the Default Outlook Contacts Folder."

 

End Sub

    lLastRow = Sheets("Blad1").Cells(Rows.Count, "A").End(xlUp).Row

 For i = 2 To lLastRow
'
'
'
next i

Sub kontaktpersoon_nieuw()
With CreateObject("Outlook.Application").CreateItem(2)
.FirstName = "first"
.LastName = "last"
.Email1Address = "snb@forum.eu"
.Save
End With
End Sub