Other Issues - Using Outlook VBA SentOnBehalfOfName, but it keeps previous entries! Help!!

In outlook, I'm trying to do the following;

• Check to see if a particular e-mail account is being used
• if so, BCC to a particular e-mail account

The following code seems to work, however, when a new email is being sent, the SentOnBehalfOfName function retains the value from the previous e-mail. This does seem to correct if I leave it for a few minutes, but I want it to pick up the latest value straight away.

Any ideas??

Sub test2()
Dim myItem As Outlook.MailItem
Dim x

x = Null '"" 'Nothing
Set myItem = Nothing

Set myItem = Application.ActiveInspector.CurrentItem
    x = myItem.SentOnBehalfOfName
        If x = "MyEmailAtTestingDotCom" Then
            With myItem
                  .BCC = "MyEmailAtTestingDotCom"

            End With
        End If

x = Null '"" 'Nothing
Set myItem = Nothing

End Sub

thanks

Pete

Private WithEvents Items As Outlook.Items

Private Sub Application_Startup()

Dim objNS As Outlook.NameSpace
  Set objNS = GetNamespace("MAPI")
  Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub

Private Sub Items_ItemAdd(ByVal item As Object)

' -------------------------------------------------------------------
' File Request System v1.0
' code by Jimmy Pena, 4-4-2026
' http://www.codeforexcelandoutlook.com
'
' To request a file, subject should be:
' Subject: FILEGET C:\MyFile.doc
'
' To send a file to a folder, subject should be:
' Subject: FILEPUT C:\
' 1. There should be at least one attachment
' 2. All attachments will be saved to the same folder
'
' Scripting Runtime object library is late-bound, you can change
' to early-bound by: a) Add a reference to the Scripting Runtime
' object library in Tools>References of the VBE
' b) Change "Dim fso As Object" to
' "Dim fso As Scripting.FileSystemObject"
' c) Change
' "Set fso = CreateObject("Scripting.FileSystemObject")" to
' "Set fso = New Scripting.FileSystemObject"
' -------------------------------------------------------------------

If TypeName(item) = "MailItem" Then
    Dim ToDo As String
    Dim WhatAndWhere As String
    Dim Msg As Outlook.MailItem
    Dim MsgAttach As Outlook.Attachments
    Dim MsgReply As Outlook.MailItem
    Dim SlashSign As Long
    Dim sPath As String
    Dim sFile As String
    Dim fso As Object
    Dim UserN As String
    Dim DeskTopSharedFolder As String
    Dim strHelpText As String

    Const strNoFolder As String = "Error: That folder does not " & _
    "exist, please resubmit with a valid folder name."
    Const strNoFilename As String = "Error: The filename should " & _
    "not be in the subject line. Please resubmit."
    Const strNoAttach As String = "Error: I'm sorry, there does " & _
    "not appear to be any attachments to your email. " & _
    "Please resend your request with the attachments you want saved."
    Const strBadSubject As String = "Error: I don't understand that " & _
    "subject. Please try again."
    Const strNoAccess As String = "Error: That folder cannot be " & _
    "accessed. Please choose another folder and try again."
    Const strNoFile As String = "Error: File doesn't exist. " & _
    "Please check the folder name and spelling."
    
    Set Msg = item

    ' get current username so we can figure out the desktop folder name
    UserN = Environ("username")
    DeskTopSharedFolder = "C:\Documents And Settings\" & _
    UserN & "\Desktop\Shared\"

    On Error Resume Next
    ToDo = Left$(Msg.Subject, 7)
    WhatAndWhere = Right$(Msg.Subject, Len(Msg.Subject) - 8)
    On Error GoTo 0

Select Case Msg.Subject
    Case "FILEGET HELP", "FILEPUT HELP", "FILE GET HELP", "FILE PUT HELP", _
 "fileget help", "fileput help", "file get help", "file put help"
    strHelpText = "Welcome to the File Request System!"
    strHelpText = strHelpText & vbCr & vbCr & "To request a file:"
    strHelpText = strHelpText & vbCr & _
"Send a blank email with "FILEGET drive:path\filename" in the subject. (without quotes)"
    strHelpText = strHelpText & vbCr & _
"Where 'drive:path\filename' is the full path and filename of the file you want."
    strHelpText = strHelpText & vbCr & "Ex: FILEGET E:\MyFolder\MyFile.doc"
    strHelpText = strHelpText & vbCr & vbCr & "To send a file:"
    strHelpText = strHelpText & vbCr & _
"Send a blank email with "FILEPUT [path]" in the subject. (without quotes)"
    strHelpText = strHelpText & vbCr & _
"There should be at least one attachment. All files will be placed in the folder you specify."
    strHelpText = strHelpText & vbCr & "Ex: FILEPUT D:\"
    strHelpText = strHelpText & vbCr & vbCr & _
"To request this help text, send a blank email with " & _
"FILEGET HELP" or "FILEPUT HELP" in the subject."

        Call SendMsg(Msg, strHelpText, , Msg.Subject)
        GoTo ExitProc
End Select
    
    If (ToDo <> "FILEGET") And (ToDo <> "FILEPUT") Then
        GoTo ExitProc
    End If

    Select Case ToDo
        Case "FILEGET", "fileget"
        
            ' check for valid folder/file name
            ' if there is no backslash, it has to be malformed
            
            SlashSign = InStrRev(WhatAndWhere, "\")
            If SlashSign = 0 Then
                Call SendMsg(Msg, strBadSubject, , ToDo)
                GoTo ExitProc
            End If
            
            ' test the path to make sure it is valid, and
            ' that it isn't the C:\ drive (except for special desktop\shared folder
            ' where we allow users to place files they want to share
            
            sPath = Left$(WhatAndWhere, SlashSign)
            If (Left$(sPath, 3) = "C:\") Or (Left$(sPath, 3) = "c:\") Then
                If sPath <> DeskTopSharedFolder Then
                    Call SendMsg(Msg, strNoAccess, , ToDo)
                    GoTo ExitProc
                End If
            End If
    
            ' check if path & file exists!
            Set fso = CreateObject("Scripting.FileSystemObject")
           
            sFile = Right$(WhatAndWhere, Len(WhatAndWhere) - SlashSign)
            
            If fso.FileExists(sPath & sFile) = False Then
                ' file doesn't exist
                ' send err msg to requestor
                Call SendMsg(Msg, strNoFile, , ToDo)
                GoTo ExitProc
            End If
            
            Call FileServ(Msg, ToDo, WhatAndWhere)

'---------------------------------------------------------------------
' what to do with orig msg?
' a) to simply mark as read, uncomment this line of code:
'
' Msg.UnRead = False
'
' b) to move to a folder, uncomment this section of code:
'
'Dim MoveFolder As Outlook.MAPIFolder
'Dim olApp As Application
'Dim olNS As NameSpace
'On Error Resume Next
'    Set olApp = Application
'    Set olNS = olApp.GetNamespace("MAPI")
'    Set MoveFolder = olNS.GetDefaultFolder(olFolderInbox).Folders("File Requests")
'On Error GoTo 0
'
'If MoveFolder = Nothing Then
'    Set MoveFolder = olNS.GetDefaultFolder(olFolderInbox).Folders.Add("File Requests")
'End If
'
'With Msg
'.UnRead = False
'.Move MoveFolder
'End With
'---------------------------------------------------------------------

        Case "FILEPUT", "fileput"
            ' if the filename is in the path,
            ' the fourth to last character will be a period
            If Mid$(WhatAndWhere, Len(WhatAndWhere) - 3, 1) = "." Then
                ' filename was in the path
                ' send err msg to requestor
                Call SendMsg(Msg, strNoFilename, , ToDo)
                GoTo ExitProc
            End If

            ' check for valid folder
            If Right$(WhatAndWhere, 1) <> "\" Then
                WhatAndWhere = WhatAndWhere & "\"
            End If
            
            Set fso = CreateObject("Scripting.FileSystemObject")
            If fso.FolderExists(WhatAndWhere) = False Then
            ' bad folder in subject line
                Call SendMsg(Msg, strNoFolder, , ToDo)
                GoTo ExitProc
            End If

            ' the file(s) should be attached, if not, exit
            Set MsgAttach = Msg.Attachments
            If MsgAttach.Attachments.Count > 0 Then
                Call FileServ(Msg, ToDo, WhatAndWhere)
            Else
                ' no attachments, send stock reply
                Call SendMsg(Msg, strNoAttach, , ToDo)
                GoTo ExitProc
            End If

    End Select
End If

ExitProc:
Set fso = Nothing
Set MsgReply = Nothing
Set MsgAttach = Nothing
Set Msg = Nothing

End Sub

http://www.devnewsgroups.net/group/microsoft.public.office.developer.outlook.vba/topic19942.aspx

 

C_A P,

Thanks for your reply on this, although I'm still struggling to resolve the problem, Outlook VBA is not my strong point.

Whilst running this piece of code the myItem.SentOnBehalfOfName displays the actual e-mail address in the From field whilst looking in the Locals Window.   However, when X = myItem.SentOnBehalfOfName, X retains the value from a previous e-mail. I've never seen this before and can't work out why this is happening.

Any ideas?

Dim myItem As Outlook.MailItem
Dim x

Set myItem = Application.ActiveInspector.CurrentItem
x = myItem.SentOnBehalfOfName

Problem solved,

If you add myItem.Save before x = myItem.SentOnBehalfOfName, it works every time!

I couldn't get the above to work properly but solved the problem using the following code (I've replaced my own addresses so any similarity to actual persons, living or dead, is purely coincidental!):

I have had the same problem - the first setting of SentOnBehalfOfName is preserved as the email address, although a second setting changes the descriptive text.