VBA Code to look up Email address in Outlook [Archive]

View Full Version : VBA Code to look up Email address in Outlook

kfschaefer

06-13-2006, 10:50 AM

I have code that will send an email upon completion of the task, it looks at the userid and returns the email address. Atleast on the local machine.

When I tried the code on another it could not find the email address for that userid.

Is there such code that will do somekindof cross reference or DLOOKUP on the Outlook global address book?

Public Function ReturnNetworkName() As String
'RETURNS NETWORK LOGIN ID OF CURRENT USER
ReturnNetworkName = Environ("UserName")
End Function
Function SendMessage() 'DisplayMsg As Boolean, Optional AttachmentPath)
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
'Dim objOutlookAttach As Outlook.Attachment
Dim strLtrContent, strLtrContentEnd, strHyperLink
' Create the Outlook session.
Set objOutlook = CreateObject("Outlook.Application")

' Create the message.
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)

With objOutlookMsg
' Add the To recipient(s) to the message.
Set objOutlookRecip = .Recipients.Add(ReturnNetworkName)
objOutlookRecip.Type = olTo

strLtrContent = "The most recent PLANIT is avail for you to copy to your local drive and scrub in your Core Scenario Planning and Dimensioning." & _
vbCrLf & vbCrLf & "Please Click on the following link, this will direct you to a SAVE AS dialog box, which defaults to your [MY Document] file, you can Click OK or redirect to the desired directory." & _
vbCrLf & vbCrLf & " "
strLtrContentEnd = "For 'Missing Node', 'Missing Market' or 'Missing Region' issues, please email Karen Schaefer. For trending related issues, please email or call Tanvir Rahman."

strHyperLink = "RegionFileCopy.mdb"

.Subject = "Manual PlanIT Forecast for Scrubbing is Completed and Ready for Your Use for the NCP"
.BodyFormat = olFormatHTML
.HTMLBody = "<HTML><HEAD><META http-equiv=Content-Type content=" & Chr$(34) & "text/html; charset=iso-8859.1" & Chr$(34) & "></HEAD>" & vbCrLf & _
"<BODY>" & strLtrContent & "<A HREF=" & Chr$(34) & strHyperLink & Chr$(34) & ">" & strHyperLink & "</A><br><p>" & strLtrContentEnd & "</BODY></HTML>"
.Send
End With

' Resolve each Recipient's name.
Set objOutlookMsg = Nothing
Set objOutlook = Nothing
End Function

Thanks,

Karen :banghead: :banghead: :banghead: :banghead:

Killian

06-14-2006, 02:24 AM

Hi Karen,

I added VBA tags to your post - hope that's OK...

Regarding the problem, you should ba able to use the Reslove method on a recipient, or (resolveall on recipients). If that doesn't work, it may be that the Global Address Book isn't referenced on the "other" machine/user profile??

Basic ResolveAll example:Dim m As MailItem

Set m = CreateItem(olMailItem)
With m
.Display
.To = "killian"
.Recipients.ResolveAll
End With

boneKrusher

06-14-2006, 10:28 AM

Killian, I think you warned me about trying to extract the email address of the sender from outlook. I've since added the email addresses to a table and used a record set to get the data. However this worked on our system. It all depends on what "olApp.Session.CurrentUser.NAME" returns. In my system it's "doe, john". Hope this helps.

Dim olApp As Outlook.Application
dim newe
dim last
dim first
dim fullemail
Set olApp = New Outlook.Application
newe = olApp.Session.CurrentUser.NAME
last = Left(newe, InStr(1, newe, ",") - 1)
first = Mid(newe, InStr(1, newe, ",") + 1)
fullemail = first & "." & last & "@domain.com"
first = LTrim(first)
fullemail = LTrim(fullemail)