stuck on how to get SendUsingAccount to work RRS feed

  • Question

  • I would be grateful for help in getting this VBA code to work. For over 10 years we have been using VBA software to send email confirmations to customers. Now we have a second company and want to send the emails as if they are coming from that company's email address. I have setup a second account in Outlook 2010 and slightly changed the existing vba code to use sendusingaccount instead of sendonbehalfofname. However the resulting emails either fail or go out from the Outlook email address. I have posted the code below which as i say has worked for over 10 years with Outlook 2000 2003 and 2010 but won't work when I have changed it to sendusingaccount. Help would be appreciated if anyone can.

    Function SendEmailSc(varRecipient As Variant, strSubject As String, strMsg As String) As Boolean
    On Error GoTo HandleErr

        Dim oLApp As Outlook.Application
        Dim objnewmail As MailItem
        If varRecipient = "@" Then
            MsgBox "Invalid E-Mail address '" & varRecipient & "'.", vbInformation, gstrSystem
            GoTo ExitHere
        End If
        Set oLApp = New Outlook.Application
        Set objnewmail = oLApp.CreateItem(olMailItem)
        With objnewmail
            .SendUsingAccount = GetCompanyDetails("ScEmailAccount")
            .Recipients.Add varRecipient
            .Subject = strSubject
            '.Body = strMsg
            .HTMLBody = strMsg
        End With
        SendEmailSc = True

        Exit Function

    ' Error handling block added by Error Handler Add-In. DO NOT EDIT this block of code.
    ' Automatic error handler last updated at 11-13-2000 11:15:38   'ErrorHandler:$$D=11-13-2000    'ErrorHandler:$$T=11:15:38

        Select Case Err.Number
            Case 70
                MsgBox "Network/Modem Disconnected.", vbCritical, gstrSystem
                Resume ExitHere
            Case Else
                Select Case errorhandler(Err.Number, Err.Description, "basEMAIL.SendEmail")   'ErrorHandler:$$N=basEMAIL.SendEmail
                    Case 1
                        Resume ExitHere
                    Case 2
                        Resume Next
                    Case 3
                End Select
        End Select

    ' End Error handling block.

    End Function

    Tuesday, August 28, 2012 3:10 PM

All replies

  • The following might help. Firstly with my testing it appears that it needs to be a pop3 account of SendUsingAccount does not work.

    Install and run the first example of code to find out the Name of the account, Item number and if it is (or is not) a pop3 account. The code will cycle through your Outlook Email accounts and return the details in message boxes.

    Sub Which_Account()
        'NOTE: If changes to the email accounts have been made in Outlook _
         then must close Outlook and Re-Open before any of this works properly.

        Dim objOutlook As Object
        Dim objNameSpace As Object
        Dim strAccountType As String
        Dim i As Long

        Set objOutlook = CreateObject("Outlook.Application")
        Set objNameSpace = objOutlook.GetNamespace("MAPI")
        For i = 1 To objNameSpace.Session.accounts.Count
            If objNameSpace.Session.accounts.Item(i).AccountType = 2 Then
                strAccountType = "pop3"
                strAccountType = "Not pop3 account"
            End If
            MsgBox "Account Name: " & Chr(9) & objNameSpace.Session.accounts.Item(i) _
                    & vbCrLf & "Account Item: " & Chr(9) & i _
                    & vbCrLf & "Account Type: " & Chr(9) & strAccountType
        Next i
        Set objNameSpace = Nothing
        Set objOutlook = Nothing

    End Sub

    Following is an example of code for a simple email message with the SendUsingAccount. Note the comments re the difference for SendUsingAccount depending on whether Early or Late binding is used.

    The Item can either be the account name enclosed in double quotes as per the example or simply use the Item number without the double quotes. It is safer to use the account name because later changes to the accounts with adding/deleting accounts could change the Item number.

    Sub SendEmailsFrom()
        'Dim objOutlook As Outlook.Application  'Early Binding
        'Dim objMailItem As Outlook.MailItem    'Early Binding
        'Dim objNameSpace As Outlook.Namespace  'Early Binding
        Dim objOutlook As Object    'Late Binding
        Dim objNameSpace As Object  'Late Binding
        Dim objMailItem As Object   'Late Binding
        Set objOutlook = CreateObject("Outlook.Application")
        Set objNameSpace = objOutlook.GetNamespace("MAPI")
        Set objMailItem = objOutlook.CreateItem(0)
        With objMailItem
            .To = "REMOVED@xxxxxxxxxx.net.au"
            .CC = "REMOVED@xxxxxxxxxx.com"
            .BCC = ""
            .Subject = "Test Email with SendUsingAccount"
            .Body = "My test email"
            'Following line used with Early Binding method (NOTE: NO Set)
            '.SendUsingAccount = objNameSpace.Session.accounts.Item("OssieMac")
            'Following line used with Late Binding Method (NOTE: Set used)
            Set .SendUsingAccount = objNameSpace.Session.accounts.Item("OssieMac")
        End With
        Set objMailItem = Nothing
        Set objNameSpace = Nothing
        Set objOutlook = Nothing
    End Sub

    Regards, OssieMac

    Wednesday, August 29, 2012 1:33 AM