Macro to send email to person in workbook list of users

  • Thread starter Thread starter amorrison2006
  • Start date Start date
A

amorrison2006

I have a macro which sends an email based on the values from one
workbook,

What I want the macro to do is to send the email to the person whose
userid is located in Users.... which is in another workbook
completely. So the macro should lookup the username in column A and
then send the email based on what is in column b next to the found
username in column A.

How is this possible using my macro below?

Private Sub MailMessage()
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Dim emailmanager As String

Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)

strbody = "This has been created by: " & UserName

If UserName = Range("A1:A100") Then Cells.Select
End If
With OutMail
.To = ANOTHERWORKBOOK.Sheets("Users").Cells.Offset(0, 2).Value
.CC = ""
.BCC = ""
.Subject = Sheets("One").Range("D6").Value & " - Prelim"
.Body = strbody
.DeleteAfterSubmit = True
.Display
End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing
End Sub


Thanks alot

Andrea
 
If I am understanding you correctly then I would say the problem is in lines:

If UserName = Range("A1:A100") Then Cells.Select
End If
With OutMail
.To = ANOTHERWORKBOOK.Sheets("Users").Cells.Offset(0, 2).Value


If your list of users is in "UserBook.xls" on a worksheet called "Users",
and held in the range "A1:A100" then try this:

strbody = "This has been created by: " & UserName

FOR nameloop = 1 TO 100
IF UserName =
Workbooks("UserBook.xls").Sheets("Users").Cells(nameloop,1).Value THEN
SendToName =
Workbooks("UserBook.xls").Sheets("Users").Cells(nameloop,2).Value
EXIT FOR
END IF
NEXT nameloop

With OutMail
.To = SendToName
......etc etc
 
I'm not sure where you get the username or where that table is, but this may
help (or not):

dim res as variant
dim myTable as range
dim username as string '?????

username = "amorrison2006"

set mytable = workbooks("someworkbookname.xls") _
.worksheets("somesheetnamehere").Range("a:b")

res = application.vlookup(username, mytable,2,false)

if iserror(res) then
msgbox "Name: " & username & " wasn't found!"
exit sub
end if

'now you can use res as the recipient.
....

.To = res
 
Back
Top