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 name and surname in separate columns,
although I could do this separately via another macro.

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

I'm no expert, but it seems the macro below creates an Outlook mail item in
the background and enters the user's name in the "To:" field and if this
resolves, then returns the user ID.

So, how do I get it to work so that it enters the user's User ID into the
"To:" field and when that resolves, to return the user's given name and
surname?

The spreadsheet I currently use with this macro has 5 columns: Given Name;
Surname; Recognised; Not Recognised; User ID.

Users enter the given names and surnames into the first two columns and when
the macro is run, it completes columns C and E if recognised or just column D
if not recognised. What I now need is for users to enter the USER ID instead
and for the macro to provide the given name and surname from that. Obviously
the columns may need to be changed around to suit the code.

The current code is below - 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