Private Sub CommandButton4_Click()
Call searchPerson
End Sub
Private Sub searchPerson()
Dim strInput$, strDefault$, strName$, strPrename$
Dim rngSearchName As Range, rngFind As Range, rngFindFirst As Range, rngResult As Range
Dim lngCnt&, strFind
Dim objOutlook, Mail As Object, objMail As Object
Set rngSearchName = Worksheets("Mitarbeitersuche").Range("A:A")
strDefault = "Name, Vorname"
strName = ""
strPrename = ""
strInput = InputBox("Bitte Name Eingeben", "searchPerson", strDefault)
If strInput = vbNullString Or strInput = strDefault Then Exit Sub
On Error Resume Next
strInput = Trim(strInput)
strName = LCase(Trim(Split(strInput, ",")(0)))
strPrename = LCase(Trim(Split(strInput, ",")(1)))
On Error GoTo 0
If strName <> "" Then
Set rngFind = rngSearchName.Find(strName, rngSearchName.Cells(1, 1), xlValues, xlPart, , xlNext)
If Not rngFind Is Nothing Then
Set rngFindFirst = rngFind
Do
If LCase(rngFind.Offset(0, 1)) Like strPrename Or strPrename = "" Then
If rngResult Is Nothing Then Set rngResult = rngFind
strFind = strFind & rngFind & ", " & rngFind.Offset(0, 1) & vbLf
lngCnt = lngCnt + 1
End If
Set rngFind = rngSearchName.FindNext(rngFind)
Loop While (rngFind.Address <> rngFindFirst.Address)
End If
End If
If Not rngResult Is Nothing And lngCnt > 0 Then
If lngCnt > 1 Then
MsgBox "Für '" & strInput & "' gab es " & lngCnt & " Treffer:" & vbLf & _
strFind & _
"" & vbLf, , "searchPerson"
Call searchPerson
ElseIf lngCnt = 1 Then
If MsgBox("Name: " & rngFind.Offset(0, 0) & vbLf & _
"Vorname: " & rngFind.Offset(0, 1) & vbLf & _
"Abteilung: " & rngFind.Offset(0, 2) & vbLf & _
"E-Mail: " & rngFind.Offset(0, 3) & vbLf & _
"Tel-Nr: " & rngFind.Offset(0, 5) & vbLf & _
"" & vbLf & _
"Möchten Sie ein E-Mail versenden?", _
vbYesNo Or vbQuestion Or vbDefaultButton2, _
"*** E-Mailversand ***") = vbYes Then
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
With objMail
.Subject = "Kundenanfrage" & " " & VBA.Date
.To = rngFind.Offset(0, 3)
.Display
End With
End If
End If
Else
MsgBox "Kein Treffer für '" & strInput & "'", vbInformation, "searchPerson"
End If
End Sub