Dim strAbsName, strAbsTel, strAbsFax, strAbsMail, strText As String
Dim strCurrentUser, strName, strTel, strFax, strMail As String
Dim rngTM, rngZelle As Range
Dim objExcel, objWorkbook, objWorksheet, objZelle As Object
strAbsName = "tex_abs_Name"
strAbsTel = "tex_abs_Tel"
strAbsFax = "tex_abs_Fax"
strAbsMail = "tex_abs_email"
strCurrentUser = Environ("username")
Debug.Print strCurrentUser
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open("C:\Users\" & strCurrentUser & "\AppData\Roaming\Microsoft\Templates\Kontaktdaten.xlsx")
Set objWorksheet = objWorkbook.Worksheets("Tabelle1")
Set objZelle = objWorksheet.UsedRange
objExcel.Visible = False
For Each rngZelle In objZelle
If rngZelle.Value = strCurrentUser Then
strName = rngZelle.Offset(0, -4).Value
strTel = rngZelle.Offset(0, -3).Value
strFax = rngZelle.Offset(0, -2).Value
strMail = rngZelle.Offset(0, -1).Value
Else
Next
End If