Option Explicit

Private Sub cmdKontaktHinzufuegen_Click()
  Dim olAppl As Outlook.Application
  Dim olNS As Outlook.NameSpace
  Dim olMAPIFolder As Outlook.MAPIFolder
  Dim olContact As Outlook.ContactItem

  On Error GoTo errMsgOL
  Set olAppl = CreateObject("Outlook.Application")
  Set olNS = olAppl.GetNamespace("MAPI")
  Set olMAPIFolder = olNS.GetDefaultFolder(olFolderContacts)

  Set olContact = olMAPIFolder.Items.Add
  With olContact
    .Categories = txtKategorie.Text
    .LastName = txtName.Text
    .FirstName = txtVorname.Text
    .HomeAddressStreet = txtStrasse.Text
    .HomeAddressPostalCode = txtPLZ.Text
    .HomeAddressCity = txtOrt.Text
    .Email1Address = txtEmail.Text
    .Save
  End With

byebye:
  Set olContact = Nothing
  Set olMAPIFolder = Nothing
  Set olNS = Nothing
  Set olAppl = Nothing

  Exit Sub

errMsgOL:
  MsgBox "Es ist ein Fehler beim Zugriff auf Outlook " & _
        aufgetreten!", vbCritical
  Resume byebye
End Sub