AW: Titel Vorname Nachname
11.04.2008 13:21:01
Tipp
Hallo Robert
vielleicht hilft Dir dies:
Du benötigst allerdings auch OUTLOOK!
Public Sub SplitNames()
'Excel
Dim aCell As Excel.Range
'Outlook
Dim objOutlook As Outlook.Application
Dim objContact As Outlook.ContactItem
On Error Resume Next
If Application.Selection Is Nothing Then
Beep
Exit Sub
End If
Set objOutlook = GetObject(, "Outlook.Application")
If Err 0 Or objOutlook Is Nothing Then
Err = 0
Set objOutlook = CreateObject("Outlook.Application")
If Err 0 Or objOutlook Is Nothing Then
Beep
MsgBox "Zugriff auf Outlook nicht moeglich: " & _
Err.Description, _
vbOKOnly + vbCritical, "!!! Problem !!!"
Exit Sub
End If
End If
Set objContact = objOutlook.CreateItem(olContactItem)
For Each aCell In Application.Selection.Cells
If aCell.Value = "" Then Exit For
With objContact
.FullName = aCell.Value
aCell.Offset(0, 1).Value = .Title
aCell.Offset(0, 2).Value = .FirstName
aCell.Offset(0, 3).Value = .MiddleName
aCell.Offset(0, 4).Value = .LastName
aCell.Offset(0, 5).Value = .Suffix
End With
DoEvents
Next aCell
Set objContact = Nothing
Set objOutlook = Nothing
End Sub
Vergiss nicht im Menü EXTRAS-VERWEISE eine Referenz auf "Microsoft Outlook x.x Object Library zu setzen ("x.x" ersetzen durch "11.0" für Outlook 2003, "10.0" für Outlook 2002/XP)
Ich hoffe, Du kommst weiter!
Grüß vom Tipp