none
What is the Access function to return my own outlook email address? RRS feed

  • Question

  • Hey guys, I want to automatically add the user's email address to the "To" line of a template email. Instead of adding their emails manually to their individual front ends... how can I have access pull the user's own email address as a string from outlook? From there I can easily paste it into my function to add the string to the To line. Thanks!
    Friday, September 6, 2019 12:39 PM

Answers

  • Perhaps something like

    Function Outlook_GetUserEmail() As String
    'REF: https://docs.microsoft.com/en-us/office/vba/api/outlook.namespace.getitemfromid
    '    #Const EarlyBind = 1 'Use Early Binding
    '    #Const EarlyBind = 0    'Use Late Binding
        #If EarlyBind Then
            Dim oOutlook          As Outlook.Application
            Dim oNameSpace        As Outlook.Namespace
        #Else
            Dim oOutlook          As Object
            Dim oNameSpace        As Object
        #End If
    
        On Error Resume Next
        Set oOutlook = GetObject(, "Outlook.Application")        'Bind to existing instance of Outlook
        If Err.Number <> 0 Then        'Could not get instance, so create a new one
            Err.Clear
            Set oOutlook = CreateObject("Outlook.Application")
        End If
        On Error GoTo Error_Handler
    
        Set oNameSpace = oOutlook.GetNamespace("MAPI")
        Outlook_GetUserEmail = oNameSpace.Accounts.Item(1).SmtpAddress
    
    Error_Handler_Exit:
        On Error Resume Next
        If Not oNameSpace Is Nothing Then Set oNameSpace = Nothing
        If Not oOutlook Is Nothing Then Set oOutlook = Nothing
        Exit Function
    
    Error_Handler:
        If Err.Number = "287" Then
            MsgBox "You clicked No to the Outlook security warning. " & _
                   "Rerun the procedure and click Yes to access e-mail " & _
                   "addresses to send your message. For more information, " & _
                   "see the document at http://www.microsoft.com/office" & _
                   "/previous/outlook/downloads/security.asp."
        Else
            MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
                   "Error Number: " & Err.Number & vbCrLf & _
                   "Error Source: Outlook_GetUserEmail" & vbCrLf & _
                   "Error Description: " & Err.Description & _
                   Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
                   , vbOKOnly + vbCritical, "An Error has Occured!"
        End If
        Resume Error_Handler_Exit
    End Function

    Then simply call it by doing

    sEmail = Outlook_GetUserEmail()

     

     

    Here's another approach

    Function Outlook_GetUserEmail2() As String
    'REF: https://docs.microsoft.com/en-us/office/vba/api/outlook.namespace.getitemfromid
    '    #Const EarlyBind = 1 'Use Early Binding
    '    #Const EarlyBind = 0    'Use Late Binding
        #If EarlyBind Then
            Dim oOutlook          As Outlook.Application
            Dim oRecip            As Outlook.Recipient
        #Else
            Dim oOutlook          As Object
            Dim oRecip            As Object
        #End If
    
        On Error Resume Next
        Set oOutlook = GetObject(, "Outlook.Application")        'Bind to existing instance of Outlook
        If Err.Number <> 0 Then        'Could not get instance, so create a new one
            Err.Clear
            Set oOutlook = CreateObject("Outlook.Application")
        End If
        On Error GoTo Error_Handler
    
        Set oRecip = oOutlook.Session.CurrentUser
        If oRecip.AddressEntry.Type = "EX" Then    'Exchange accounts ****untested*****
            Outlook_GetUserEmail2 = oRecip.AddressEntry.GetExchangeUser().PrimarySmtpAddress
        Else    'normal accounts   WORKS FINE
            Outlook_GetUserEmail2 = oRecip.Address
        End If
    
    Error_Handler_Exit:
        On Error Resume Next
        If Not oRecip Is Nothing Then Set oRecip = Nothing
        If Not oOutlook Is Nothing Then Set oOutlook = Nothing
        Exit Function
    
    Error_Handler:
        If Err.Number = "287" Then
            MsgBox "You clicked No to the Outlook security warning. " & _
                   "Rerun the procedure and click Yes to access e-mail " & _
                   "addresses to send your message. For more information, " & _
                   "see the document at http://www.microsoft.com/office" & _
                   "/previous/outlook/downloads/security.asp."
        Else
            MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
                   "Error Number: " & Err.Number & vbCrLf & _
                   "Error Source: Outlook_GetUserEmail2" & vbCrLf & _
                   "Error Description: " & Err.Description & _
                   Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
                   , vbOKOnly + vbCritical, "An Error has Occured!"
        End If
        Resume Error_Handler_Exit
    End Function


    Daniel Pineault, 2010-2019 Microsoft MVP
    Professional Support: http://www.cardaconsultants.com
    MS Access Tips and Code Samples: http://www.devhut.net


    Friday, September 6, 2019 1:41 PM

All replies

  • Perhaps something like

    Function Outlook_GetUserEmail() As String
    'REF: https://docs.microsoft.com/en-us/office/vba/api/outlook.namespace.getitemfromid
    '    #Const EarlyBind = 1 'Use Early Binding
    '    #Const EarlyBind = 0    'Use Late Binding
        #If EarlyBind Then
            Dim oOutlook          As Outlook.Application
            Dim oNameSpace        As Outlook.Namespace
        #Else
            Dim oOutlook          As Object
            Dim oNameSpace        As Object
        #End If
    
        On Error Resume Next
        Set oOutlook = GetObject(, "Outlook.Application")        'Bind to existing instance of Outlook
        If Err.Number <> 0 Then        'Could not get instance, so create a new one
            Err.Clear
            Set oOutlook = CreateObject("Outlook.Application")
        End If
        On Error GoTo Error_Handler
    
        Set oNameSpace = oOutlook.GetNamespace("MAPI")
        Outlook_GetUserEmail = oNameSpace.Accounts.Item(1).SmtpAddress
    
    Error_Handler_Exit:
        On Error Resume Next
        If Not oNameSpace Is Nothing Then Set oNameSpace = Nothing
        If Not oOutlook Is Nothing Then Set oOutlook = Nothing
        Exit Function
    
    Error_Handler:
        If Err.Number = "287" Then
            MsgBox "You clicked No to the Outlook security warning. " & _
                   "Rerun the procedure and click Yes to access e-mail " & _
                   "addresses to send your message. For more information, " & _
                   "see the document at http://www.microsoft.com/office" & _
                   "/previous/outlook/downloads/security.asp."
        Else
            MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
                   "Error Number: " & Err.Number & vbCrLf & _
                   "Error Source: Outlook_GetUserEmail" & vbCrLf & _
                   "Error Description: " & Err.Description & _
                   Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
                   , vbOKOnly + vbCritical, "An Error has Occured!"
        End If
        Resume Error_Handler_Exit
    End Function

    Then simply call it by doing

    sEmail = Outlook_GetUserEmail()

     

     

    Here's another approach

    Function Outlook_GetUserEmail2() As String
    'REF: https://docs.microsoft.com/en-us/office/vba/api/outlook.namespace.getitemfromid
    '    #Const EarlyBind = 1 'Use Early Binding
    '    #Const EarlyBind = 0    'Use Late Binding
        #If EarlyBind Then
            Dim oOutlook          As Outlook.Application
            Dim oRecip            As Outlook.Recipient
        #Else
            Dim oOutlook          As Object
            Dim oRecip            As Object
        #End If
    
        On Error Resume Next
        Set oOutlook = GetObject(, "Outlook.Application")        'Bind to existing instance of Outlook
        If Err.Number <> 0 Then        'Could not get instance, so create a new one
            Err.Clear
            Set oOutlook = CreateObject("Outlook.Application")
        End If
        On Error GoTo Error_Handler
    
        Set oRecip = oOutlook.Session.CurrentUser
        If oRecip.AddressEntry.Type = "EX" Then    'Exchange accounts ****untested*****
            Outlook_GetUserEmail2 = oRecip.AddressEntry.GetExchangeUser().PrimarySmtpAddress
        Else    'normal accounts   WORKS FINE
            Outlook_GetUserEmail2 = oRecip.Address
        End If
    
    Error_Handler_Exit:
        On Error Resume Next
        If Not oRecip Is Nothing Then Set oRecip = Nothing
        If Not oOutlook Is Nothing Then Set oOutlook = Nothing
        Exit Function
    
    Error_Handler:
        If Err.Number = "287" Then
            MsgBox "You clicked No to the Outlook security warning. " & _
                   "Rerun the procedure and click Yes to access e-mail " & _
                   "addresses to send your message. For more information, " & _
                   "see the document at http://www.microsoft.com/office" & _
                   "/previous/outlook/downloads/security.asp."
        Else
            MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
                   "Error Number: " & Err.Number & vbCrLf & _
                   "Error Source: Outlook_GetUserEmail2" & vbCrLf & _
                   "Error Description: " & Err.Description & _
                   Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
                   , vbOKOnly + vbCritical, "An Error has Occured!"
        End If
        Resume Error_Handler_Exit
    End Function


    Daniel Pineault, 2010-2019 Microsoft MVP
    Professional Support: http://www.cardaconsultants.com
    MS Access Tips and Code Samples: http://www.devhut.net


    Friday, September 6, 2019 1:41 PM
  • Daniel, you're a damn guru.
    Friday, September 6, 2019 1:47 PM