Extract current user E-mail address (VB/Outlook)

[JackG]

I have a VB6.0 application that creates a Crystal report and sends it out via Outlook 2000 e-mail. It also creates a file listing those e-mail recipients. I want this list e-mailed to the user that is currently running the application. Therefore I need to extract the current user's Outlook e-mail address.

I have used the following code to do this:
Public Function CurrentUserEmailaddress() As String

Dim straddresses

Dim CdoSession As MAPI.Session
Set CdoSession = New MAPI.Session

'Set objSession = CreateObject("MAPI.Session")

On Error Resume Next

CdoSession.Logon 'ShowDialog:=True, NewSession:=False

Select Case Err.Number
Case -2147221231
On Error GoTo 0
On Error Resume Next
CdoSession.Logon ShowDialog:=False, NewSession:=True ', profileinfo:="MSXServer" & vbLf & Environ("UserName")
If Err.Number <> 0 Then

CurrentUserEmailaddress = "admin@XXXXX.XXX"
Exit Function
End If

End Select

straddresses = CdoSession.CurrentUser.Address

CdoSession.Logoff
Set CdoSession = Nothing

CurrentUserEmailaddress = straddresses

End Function

This code was taken and modified form a previous post in this forum. I works. The message is e-mailed to the correct user. BUT the application dies with a fatal error after it sends the mail. The code that sends the mail is:
strEMailSenderName1 = CurrentUserEmailaddress
Set objOL = CreateObject("Outlook.Application")
Set objEMail = objOL.CreateItem(olMailItem)
With objEMail
.Recipients.Add strEMailSenderName1
.Subject = "Maximum Leave Notification Lists"
.Body = strFromFileTEXT
.Send
End With
'
Set objEMail = Nothing
Set objOL = Nothing

If I hard code an e-mail address in the the above routine the process terminates normally, With the function call to extract the address is gets the fatal error.

This all happens in a Windows NT 4.0 environment.

Thanks for any insight.

[HansV]

<P ID="edit" class=small>(Edited by HansV on 11-Dec-02 16:30. Corrected a typo in the code and added a note.)</P>If you're starting Outlook anyway, it's not necessary to use a separate function to retrieve the current user. It's readily available as

objOL.Session.CurrentUser

BTW, you don't quit Outlook; this may lead to invisible instances of Outlook staying in memory. Here is revised code that

(1) Checks whether Outlook is already active; uses the active instance if available, starts Outlook otherwise.
(2) Quits Outlook at the end only if we started it.
(3) Uses objOL.Session.CurrentUser.

Sub TestMail()
Dim strEMailSenderName1 As String
Dim objOL As Outlook.Application
Dim objEMail As Outlook.MailItem
Dim strFromFileText As String
strFromFileText = "Hello World"
Dim blnHaveToQuit As Boolean
On Error Resume Next
Set objOL = GetObject(, "Outlook.Application")
If objOL Is Nothing Then
Set objOL = CreateObject("Outlook.Application")
If objOL Is Nothing Then
MsgBox "Can't start Outlook", vbCritical
Exit Sub
End If
blnHaveToQuit = True
End If
On Error GoTo Err_Handler
Set objEMail = objOL.CreateItem(olMailItem)
strEMailSenderName1 = objOL.Session.CurrentUser
With objEMail
.Recipients.Add strEMailSenderName1
.Subject = "Maximum Leave Notification Lists"
.Body = strFromFileText
.Send
End With

Exit_Handler:
On Error Resume Next
Set objEMail = Nothing
If blnHaveToQuit Then
objOL.Quit
End If
Set objOL = Nothing
Exit Sub

Err_Handler:
MsgBox Err.Description, vbCritical
Resume Exit_Handler
End Sub

Note for others wanting to use this code: it needs a reference to the Outlook Type Library to be set in Tools/References...

[JackG]

I tried the revisions you suggested and they work great. Seems the simple was is usually best.
Thanks!

[PhilJeary]

I don't suppose you'd be able to post the code you used to send the crystal report?

If you don't have the code, a clue will do. Did the report send as a crystal report or did you print it as a pdf or export it as word first?

Regards,
Phil

[JackG]

Hope this code leads you down the right road.

If adoEMailRecordSet.EOF Then
'SET THE CRYSAL REPORT SELECTION PARAMETERS ON THE FLY
strSSNToFind = "'" & adoRecordSet("SSN") & "'"
strCondition = "{Leave Letters.SSN} = " & strSSNToFind & strConstantConditional
' NAME OF REPORT TO RUN
strCrystalReportName = strLostLeaveCrystalReportName
'CALL CR WITH THE CRYSTAL REPORT CONTROL ON THE FORM (CRYSTL32.OCX)
'SEND CR OUTPUT TO A PRINTER
With CrystalReport1
.Reset
.DiscardSavedData = True
.Destination = crptToPrinter
.ReportFileName = strCrystalReportName
.SelectionFormula = strCondition
.Action = 1
End With
Write #2, adoPernameRecSet("Last Name"), adoPernameRecSet("First Name"), _
adoPernameRecSet("Street"), adoPernameRecSet("City"), _
adoPernameRecSet("State"), adoPernameRecSet("Zip")
intLettersPrinted = intLettersPrinted + 1
' Found on XXXXXXX and is to receive e-mail; create report
ElseIf adoEMailRecordSet("EMail-SW") = "Y" Then _
emailAddres = adoEMailRecordSet("E-Mail")
strSSNToFind = "'" & adoRecordSet("SSN") & "'"
strPretendFromFileSNN = adoRecordSet("SSN")
strCondition = "{Leave Letters.SSN} = " & strSSNToFind & strConstantConditional
strCrystalReportName = strLostLeaveCrystalReportName
strPrintFileName = strOutputReportPath & strPretendFromFileSNN & ".doc"
'CALL CR WITH THE CRYSTAL REPORT CONTROL ON THE FORM (CRYSTL32.OCX)
'SEND CR OUTPUT TO A TEXT FILE

With CrystalReport1
.Reset
.PrintFileType = crptText
.Destination = crptToFile
.PrintFileName = strEmailAdressFile
.ReportFileName = strCrystalReportName
.SelectionFormula = strCondition
.Action = 1
.PrintReport
End With

[PhilJeary]

Thanks Jack, ill see what I can do before I finish work, if not ill be back onto it monday!

Having the usual fun with converting a program from access to VB & Crystal.......... joy!