Get Sender's email address in Outlook 2002 and below

[darrellblackhawk]

Many of us have tried to figure out how to get a sender's
email address when automating Outlook before version 2003
(SenderEmailAddress).

I was just playing around with this again today and came
up with a work-around to retrieve it, even though Outlook
2002 and below doesn't expose it in its object model.

Once you've got a reference to an email item; [blue]oMailItem
in the example below[/blue], you save it using the the mail items
saveas() method, then pull out the sender's email address
which will be the last word on the first line.

e.g.

#define SaveFile "PathAndFileName"

oMailItem.saveas(SaveFile,0)
cSenderAddress = filetostr(SaveFile)
cSenderAddress = left(cSenderAddress,at(chr(13),cSenderAddress)-1)
cSenderAddress = chrtran(substr(cSenderAddress,rat(" ",cSenderAddress)+1),"[]","")

Darrell

 

[MarciaAkins]

Hi Darrell.

This is another alternative.

IF '@' $ loItem.SenderName
  lcSenderEm2 = loItem.SenderName
ELSE
  IF empty( loItem.To )
    *** don't reply - this is just a draft
    lcSenderEm2 = "Draft"
  ELSE
    loReply = loItem.Reply()
    loRecip = loReply.Recipients[ 1 ]
    lcSenderEm2 = IIF( NOT EMPTY( loRecip.Address ), loRecip.Address, loRecip.Name )
  ENDIF
ENDIF

Marcia G. Akins

http://www.TightlineComputers.com

 

[darrellblackhawk]

Marcia:

Yes that is one possible way, but many times the actual Sender's email address is not contained in the reply to recipients or senders name.

The actual Sender's email address wasn't exposed until Outlook 2003.

The reason Microsoft didn't expose the sender's email address is up for grabs. Maybe an oversight; which is highly unlikley. I assume something else, but I won't speculate about it.

Darrell

 

[MarciaAkins]

but many times the actual Sender's email address is not contained in the reply to recipients or senders name

Hmmmm. In what instances will the code that I posted not work? I know that Whil Hentzen and I worked on that for an article he did in FoxTalk in November 2002 on Outlook.



Marcia G. Akins

http://www.TightlineComputers.com

 

[darrellblackhawk]

Marcia:

If you run the following code on a system with
Outlook 2002 or below, you'll notice emails that
don't have replyto recipients, only have a text value in
the sender's name, or the replyto recipients are different
than the sender.

You'll probably have to review a number of emails,
but you will find some that fit the description above.

I haven't reviewed the relevant rfc's in relation to
properly formed email addresses, but I vaguely remember
conditions where email programs won't parse email
addresses properly that don't adhere to the standard.

Rfc's notwithstanding, the fact remains that Microsoft
didn't expose the actul sender's email address until
Outlook 2003; which was a constant complaint.

Darrell

local oOutlookEmailInfoForm
oOutlookEmailInfoForm = createobject("CGetOutLookEmails")
oOutlookEmailInfoForm.show()
read events

define class CGetOutLookEmails as form

  docreate = .t.
  autocenter = .t.
  datasession = 2
  width = 800
  height = 400
  caption = "Retrieving Pre Outlook 2003 received emails sender's address"
  oOutLook = null
  oCurrentFolder = null
  oNameSpace = null
  oFolder = null
  nCurEmail = 0
  cSaveFile = addbs(sys(2023))+sys(2015)+".txt"
  cEmailInfo = ""
  cStatus = ""

  add object edtEmailInfo as editbox with ;
    top = 10, ;
    left = 10, ;
    width = this.width - 20, ;
    height = 300, ;
    fontname = "courier new", ;
    fontsize = 12, ;
    controlsource = "thisform.cEmailInfo"

  add object cmdNextEmail as commandbutton with ;
    top = this.edtEmailInfo.top + this.edtEmailInfo.height + 10, ;
    left = 10, ;
    caption = "Get next email", ;
    width = 120, ;
    height = 27

  add object cmdPreviousEmail as commandbutton with ;
    top = this.cmdNextEmail.top + this.cmdNextEmail.height + 10, ;
    left = 10, ;
    caption = "Get Previous email", ;
    width = 120, ;
    height = 27

  add object txtStatus as textbox with ;
    top = this.cmdNextEmail.top, ;
    left = 140, ;
    width = 280, ;
    height = 27, ;
    fontname = "courier new", ;
    fontsize = 12, ;
    controlsource = "thisform.cStatus"


  procedure load
    set talk off
    set safe off
    set cent on
    set cpdialog off
  endproc

  protected procedure init
    this.oOutLook = newobject("Outlook.Application")
    this.oNameSpace = this.oOutLook.GetNameSpace("MAPI")
    this.oCurrentFolder = this.oNameSpace.GetDefaultFolder(6)
  endproc

  protected procedure destroy
    this.oCurrentFolder = null
    this.oNameSpace = null
    this.oFolder = null
    this.oOutLook = null
    delete file (this.cSaveFile)
    clear events
  endproc

  procedure GetEmail
    lparam nDir

    local  oMailItem, i, cSenderAddress

    this.cEmailInfo = ""

    if nDir = 0
      this.nCurEmail = this.nCurEmail + 1
      if this.nCurEmail > this.oCurrentFolder.items.count
        this.nCurEmail = 1
      endif
    else
      this.nCurEmail = this.nCurEmail - 1
      if this.nCurEmail < 1
        this.nCurEmail = this.oCurrentFolder.items.count
      endif
    endif

    oMailItem = this.oCurrentFolder.items(this.nCurEmail)
    oMailItem.saveas(this.cSaveFile,0)
    cSenderAddress = filetostr(this.cSaveFile)
    cSenderAddress = left(cSenderAddress,at(chr(13),cSenderAddress)-1)
    cSenderAddress = chrtran(substr(cSenderAddress,rat(" ",cSenderAddress)+1),"[]","")

    this.cEmailInfo = this.cEmailInfo + ;
      "Email Size:                " +trans(oMailItem.size) + chr(13) + ;
      "Received Time:             " +trans(oMailItem.ReceivedTime) + chr(13) + ;
      "Sender's Email Address:    " +cSenderAddress + chr(13) + ;
      "Subject:                   " +oMailItem.subject + chr(13) + ;
      "Sender's Name:             " +oMailItem.SenderName + chr(13) + ;
      "ReplyTo Recipient's Names: " +oMailItem.ReplyRecipientNames + chr(13)

    for i = 1 to oMailItem.ReplyRecipients.count

      this.cEmailInfo = this.cEmailInfo + ;
        "  ReplyTo Recipient #"+trans(i)+":    " + ;
        oMailItem.ReplyRecipients.item(i).address + chr(13)

    next
    this.cEmailInfo = this.cEmailInfo + chr(13)
    this.refresh()

  endproc

  procedure refresh
    this.cStatus = "Email: "+trans(this.nCurEmail)+" of: "+trans(this.oCurrentFolder.items.count)
    dodefault()
  endproc

  procedure cmdNextEmail.click
    thisform.GetEmail(0)
  endproc
  procedure cmdPreviousEmail.click
    thisform.GetEmail(1)
  endproc

enddefine

 

[darrellblackhawk]

What prompted me to start this thread is the fact that
I'm creating an application that will transfer large
quantities of emails to SQL server and then will delete
them from Outlook.

I'm upgrading to Outlook 2003 and don't want to transfer
these emails, but I do want to keep them archived for
reference.

As you know, searching emails can be slow in Outlook if
you have a large quantity - I have many thousands in
multiple folders.

Darrell

 

[Mike Gagnon]

Darrell

Just as a side note notice that if I use CDO to send an e-mail, I can actually make up the SendersName and not have to specify the sender's e-mail address, so things are not always as them seem. Untraceable e-mails.


Mike Gagnon

If you want to get the best response to a question, please check out FAQ184-2483 first.

 

[darrellblackhawk]

Hmmm... You're right. You can also forge an email address.

I was interested in received emails currently residing
in one/all of the inboxes.

The code I posted is very slow where an email is larger
than approx. 6k, but it works.

Without having access to whatever Microsoft uses to access
the sender's email address, I had to resort to the method
above, to insure I was retrieving the actual email address
everytime.


Darrell