Hello

I have a macro which I've been using for quite some time. This macro allows
the user to identify the User IDs of people listed in the spreadsheet.

However, I now need a macro to do the reverse. That is, it needs to find the
names of people whose User IDs are listed in the spreadsheet. If possible, it
would be great to list the given anme and surname in separate columns.

Is it possible to modify the macro below to achieve what I want (i.e. so
that it does the reverse of what it currently does)?

Any help would be greatly appreciated!

Joe.
--
If you can measure it, you can improve it!




Sub CheckUserIDsForEmail()
'
' CheckUserIDsForEmail Macro
'
Dim objOL As Object
Dim objMailItem As Object
Dim strUserIDs As String
Dim i As Integer
Dim c As Object
Dim objRecipient As Object
Dim strAddress As String

If MsgBox("This will check each of the names entered to see if it is
recognised by Outlook. Continue?", vbYesNoCancel) = vbYes Then

Application.Cursor = xlWait

Set objOL = CreateObject("Outlook.Application")
Set objMailItem = objOL.CreateItem(olMailItem)

With objMailItem

For Each c In ActiveSheet.UsedRange.Columns(1).Cells
If c.Value < "UserIDs" And Trim(c.Value) < "" Then
.To = c.Value & "." & c.Offset(0, 1).Value
For i = 1 To .Recipients.Count
If .Recipients(i).Resolve Then
Cells(c.Row, c.Column + 2).Value = Cells(c.Row,
c.Column + 2).Value & .Recipients(i).Name & "; "
strAddress = .Recipients(i).Address
strUserIDs = Right(strAddress, 5)
Cells(c.Row, c.Column + 4).Value = Cells(c.Row,
c.Column + 4).Value & strUserIDs & "; "
Else
Cells(c.Row, c.Column + 3).Value = Cells(c.Row,
c.Column + 3).Value & .Recipients(i).Name & "; "
End If
Next i
End If
Next c

End With

Application.Cursor = xlDefault

End If

End Sub

I developed this code to return the User Name. You might want to
revise it so it picks up its input from a range rather than an
INPUTBOX statement.

Regards

Greg



Sub ReturnUserNamefromID()

'This routine returns the Outlook Common Name from the known User
ID

Dim UserID As String
Dim OutObj As New Outlook.Application
Dim Mail As Object
Set Mail = OutObj.CreateItem(0)

UserID = InputBox("Enter the UserID", "Email Lookup")

Mail.To = UserID
If Mail.Recipients.ResolveAll Then
MsgBox Mail.To

Else

Debug.Print Mail.To & " did not resolve"

End If
Set Mail = Nothing

End Sub