Public Sub Kontakt_erstellen(ByVal dt_Ma As DataTable)
        Dim MsgBoxResult As MsgBoxResult
 
        Progress = 2
 
        MsgBoxResult = MsgBox("Wollen Sie die Kontake in Outlook erstellen?" & _
          vbLf & vbLf & "Gleichnamige Kontakte werden gelöscht.", _
          MsgBoxStyle.YesNo, "Erstellung Kontakte")
 
        If MsgBoxResult = vbNo Then
            Exit Sub
        End If
 
        If MsgBoxResult = vbYes Then
            Dim progressForm As New TaskProgress()
            progressForm.Show()
            ' Bei der Aktualisierung wird die Bezeichnung unmittelbar angezeigt.
            progressForm.Refresh()
 
            Dim count As Integer = dt_Ma.Rows.Count
            Try
                For Each r As DataRow In dt_Ma.Rows
 
                    Dim olApp As Outlook.Application
                    olApp = CreateObject("Outlook.Application")
 
                    ' Logon. Doesn't hurt if you are already running and logged _
                      on...
                    Dim olNs As Outlook.NameSpace
                    olNs = olApp.GetNamespace("MAPI")
                    olNs.Logon()
 
                    'Kontakt suchen und löschen
                    FindContact(r("Vorname").ToString, r("Name").ToString)
 
                    ' Create and Open a new contact.
                    Dim olItem As Outlook.ContactItem
                    olItem = olApp.CreateItem(Outlook.OlItemType.olContactItem)
 
                    ' Setup Contact information...
                    With olItem
                        .Title = r("Anrede").ToString
                        '.AssistantName = ""
                        .FirstName = r("Vorname").ToString
                        .LastName = r("Name").ToString
                        '.FullName = FirstName & " " & LastName
                        .FileAs = r("Name").ToString & "," & r( _
                          "Vorname").ToString
                        .JobTitle = r("Position").ToString
                        If r("Geburtsdatum").ToString = "" Then
                        Else
                            .Birthday = CDate(r("Geburtsdatum").ToString)
                        End If
                        .BusinessAddress = r("Adresse").ToString
                        .CompanyName = r("FirmenName").ToString
                        '.BusinessAddressCity = ""
                        '.BusinessAddressPostalCode = ""
                        .BusinessFaxNumber = r("Fax").ToString
                        .BusinessTelephoneNumber = r("Telefon_G").ToString
                        '.BusinessHomePage = ""
                        .MobileTelephoneNumber = r("Handy").ToString
                        .HomeTelephoneNumber = r("Telefon_P").ToString
                        .HomeAddress = r("Adresse_P").ToString
                        '.HomeAddressStreet = ""
                        '.HomeAddressCity = ""
                        '.HomeAddressPostalCode = ""
                        .Email1Address = r("Email_G").ToString
                        '.Email1DisplayName = ""
                        .Email2Address = r("Email_P").ToString
                        '.Email2DisplayName = ""
                        '.WebPage = ""
                        '.PersonalHomePage = ""
                        '.Display()
                    End With
 
                    ' Save Contact...
                    olItem.Save()
 
                    olNs.Logoff()
                    olNs = Nothing
                    'olMail = Nothing
                    'olAppt = Nothing
                    olItem = Nothing
                    olApp = Nothing
 
                    Progress = Progress + (100 / count) '- 1
                    If Progress >= 100 Then
                        Progress = 100
                    End If
                    progressForm.ProgressIndicator.Value = Progress
                Next
                MsgBox("Daten wurden an Outlook übergeben.", _
                  MsgBoxStyle.Information, "Kontakt wurde übertragen")
 
            Catch ex As Exception
                MsgBox("Leider konnten nicht alle Kontakte an Outlook übergeben" & _
                  "werden." & vbLf & vbLf & ex.ToString())
            End Try
            ' Formular nach Beendigung der "Aufgabe" entfernen.
            progressForm.Hide()
            progressForm.Dispose()
        End If
 
    End Sub