M
Monomeeth
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 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