Results 1 to 6 of 6
  1. #1
    New Lounger
    Join Date
    Jan 2002
    Posts
    18
    Thanks
    0
    Thanked 0 Times in 0 Posts

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

    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.

  2. #2
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

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

    <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...

  3. #3
    New Lounger
    Join Date
    Jan 2002
    Posts
    18
    Thanks
    0
    Thanked 0 Times in 0 Posts

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

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

  4. #4
    4 Star Lounger
    Join Date
    Feb 2001
    Location
    Gillingham, Kent, England
    Posts
    511
    Thanks
    0
    Thanked 0 Times in 0 Posts

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

    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

  5. #5
    New Lounger
    Join Date
    Jan 2002
    Posts
    18
    Thanks
    0
    Thanked 0 Times in 0 Posts

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

    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

  6. #6
    4 Star Lounger
    Join Date
    Feb 2001
    Location
    Gillingham, Kent, England
    Posts
    511
    Thanks
    0
    Thanked 0 Times in 0 Posts

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

    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!

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •