M
Monomeeth
Hi Everyone
Our organisation uses Microsoft Exchange Servers to manage email accounts
and each user is given a unique 5 character UserID. All email addresses are
in the form of firstname.lastname@ourdomain.
I have a macro which is used to check a person's name to see if outlook
recognises it and, if so, it identifies the person's UserID. The problem is
that the person's name is entered Column A for the macro to interrogate. I
would like to modify this macro so that I can enter the first name into
column A and the last name into Column B and for the macro to join the two
together as one name before doing its magic.
Any help would be most appreciated.
The code is below:
-----------------------------------------------------------------
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 in the first column 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
For i = 1 To .Recipients.Count
If .Recipients(i).Resolve Then
Cells(c.Row, c.Column + 1).Value = Cells(c.Row,
c.Column + 1).Value & .Recipients(i).Name & "; "
strAddress = .Recipients(i).Address
strUserIDs = Right(strAddress, 5)
Cells(c.Row, c.Column + 3).Value = Cells(c.Row,
c.Column + 3).Value & strUserIDs & "; "
Else
Cells(c.Row, c.Column + 2).Value = Cells(c.Row,
c.Column + 2).Value & .Recipients(i).Name & "; "
End If
Next i
End If
Next c
End With
Application.Cursor = xlDefault
End If
End Sub
Our organisation uses Microsoft Exchange Servers to manage email accounts
and each user is given a unique 5 character UserID. All email addresses are
in the form of firstname.lastname@ourdomain.
I have a macro which is used to check a person's name to see if outlook
recognises it and, if so, it identifies the person's UserID. The problem is
that the person's name is entered Column A for the macro to interrogate. I
would like to modify this macro so that I can enter the first name into
column A and the last name into Column B and for the macro to join the two
together as one name before doing its magic.
Any help would be most appreciated.
The code is below:
-----------------------------------------------------------------
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 in the first column 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
For i = 1 To .Recipients.Count
If .Recipients(i).Resolve Then
Cells(c.Row, c.Column + 1).Value = Cells(c.Row,
c.Column + 1).Value & .Recipients(i).Name & "; "
strAddress = .Recipients(i).Address
strUserIDs = Right(strAddress, 5)
Cells(c.Row, c.Column + 3).Value = Cells(c.Row,
c.Column + 3).Value & strUserIDs & "; "
Else
Cells(c.Row, c.Column + 2).Value = Cells(c.Row,
c.Column + 2).Value & .Recipients(i).Name & "; "
End If
Next i
End If
Next c
End With
Application.Cursor = xlDefault
End If
End Sub