Consulting

Results 1 to 16 of 16

Thread: Adding a BCC depending on sender address

  1. #1
    VBAX Contributor
    Joined
    Nov 2020
    Location
    Swansea,South Wales,UK
    Posts
    103
    Location

    Adding a BCC depending on sender address

    Hi everyone,
    I have some code that allows me to amend Good day, to whatever it should be, depending on the time of day.

    I now have the need to add a BCC as I use 3 different computers, and whilst the IMAP syncs all incoming mail, it does not for outgoing mail.

    This is the code I am trying to use, however the SenderEmailAddress is empty, so it fails all the time.

    How can I implement this extra option please.

    Private Sub Application_ItemSend(ByVal item As Object, Cancel As Boolean)
        Dim strGreeting As String
        Dim iTime As Integer
        Dim strBody As String, strDivCode As String
        strGreeting = ""
        strDivCode = "<div class=WordSection1><p class=MsoNormal>"
        iTime = Val(Format(Now(), "hh"))
        ' Quit if not a mail item
        If TypeName(item) <> "MailItem" Then
            Exit Sub
        End If
        Select Case iTime
             Case Is < 12
                 strGreeting = "morning "
             Case Is < 17
                 strGreeting = "afternoon "
             Case Else
                 strGreeting = "evening "
        End Select
        strGreeting = "Good " & strGreeting
        ' Now add a BCC if JAG email address
        If item.SenderEmailAddress = "xxxx@yyyyy.co.uk" Then
            item.BCC = item.BCC & ";ttttttttt@gmail.com"
        End If
        If Left(item.BCC, 1) = ";" Then item.BCC = Mid(item.BCC, 2)
        strBody = item.HTMLBody
        strBody = Replace(strBody, "Good day", strGreeting)
        'strBody = Replace(strBody, strDivCode, strDivCode & strGreeting)
        item.HTMLBody = strBody
    End Sub

  2. #2
    Moderator VBAX Wizard Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    5,183
    Location
    Welcome back to VBAX Gasman. Been a while if my memory serves me right.
    Remember To Do the Following....
    Use [Code].... [/Code] tags when posting code to the thread.
    Mark your thread as Solved if satisfied by using the Thread Tools options.
    If posting the same issue to another forum please show the link

  3. #3
    Moderator VBAX Wizard Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    5,183
    Location
    Does this give you any assistance?

    Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    Dim msg As MailItem
    Dim strGreeting
    Dim hrs As Long
    Dim mins As Long
    Dim lngTime As Long
    hrs = Val(Left(Format(Time, "HH:mm"), 2))
    mins = Val(Right(Format(Time, "HH:mm"), 2))
    lngTime = 60 * hrs + mins
    Select Case lngTime
        Case Is <= 720
            strGreeting = "Good Morning"
        Case Is > 960
            strGreeting = "Good Evening"
        Case Else
            strGreeting = "Good Afternoon"
    End Select
    Set msg = Application.ActiveInspector.CurrentItem
    msg.Body = strGreeting & vbCr & msg.Body
    If InStr(1, msg.Body, "attach", vbTextCompare) > 0 Then
        If msg.Attachments.Count = 0 Then
            If MsgBox("There's no attachment, send anyway?", vbYesNo) = vbNo then
                Cancel = True
            End If
        End If
    End If
    End Sub
    Remember To Do the Following....
    Use [Code].... [/Code] tags when posting code to the thread.
    Mark your thread as Solved if satisfied by using the Thread Tools options.
    If posting the same issue to another forum please show the link

  4. #4
    VBAX Contributor
    Joined
    Nov 2020
    Location
    Swansea,South Wales,UK
    Posts
    103
    Location
    Quote Originally Posted by Aussiebear View Post
    Welcome back to VBAX Gasman. Been a while if my memory serves me right.
    Thank you. It has been quiet on the Access front. :-)
    Now I need assistance.

  5. #5
    VBAX Contributor
    Joined
    Nov 2020
    Location
    Swansea,South Wales,UK
    Posts
    103
    Location
    Just tried this

        Set msg = Application.ActiveInspector.currentItem
        Debug.Print msg.SenderEmailAddress
    but result is the same?

    Quote Originally Posted by Aussiebear View Post
    Does this give you any assistance?

    Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    Dim msg As MailItem
    Dim strGreeting
    Dim hrs As Long
    Dim mins As Long
    Dim lngTime As Long
    hrs = Val(Left(Format(Time, "HH:mm"), 2))
    mins = Val(Right(Format(Time, "HH:mm"), 2))
    lngTime = 60 * hrs + mins
    Select Case lngTime
        Case Is <= 720
            strGreeting = "Good Morning"
        Case Is > 960
            strGreeting = "Good Evening"
        Case Else
            strGreeting = "Good Afternoon"
    End Select
    Set msg = Application.ActiveInspector.CurrentItem
    msg.Body = strGreeting & vbCr & msg.Body
    If InStr(1, msg.Body, "attach", vbTextCompare) > 0 Then
        If msg.Attachments.Count = 0 Then
            If MsgBox("There's no attachment, send anyway?", vbYesNo) = vbNo then
                Cancel = True
            End If
        End If
    End If
    End Sub

  6. #6
    VBAX Contributor
    Joined
    Nov 2020
    Location
    Swansea,South Wales,UK
    Posts
    103
    Location
    Found a copy at
    item.SendUsingaccount.smtpaddress

  7. #7
    VBAX Contributor
    Joined
    Nov 2020
    Location
    Swansea,South Wales,UK
    Posts
    103
    Location
    Spoke too soon. :-(

    I get the BCC in, but I get this back

    Your message did not reach some or all of the intended recipients.

    Subject: test send bcc
    Sent: 15/03/2024 14:22

    The following recipient(s) cannot be reached:

    With no email addresses mentioned. :-(

  8. #8
    Moderator VBAX Wizard Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    5,183
    Location
    Okay, what about this effort
    Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    Dim msg As MailItem
    Dim strGreeting
    Dim hrs As Long
    Dim mins As Long
    Dim lngTime As Long
    hrs = Val(Left(Format(Time, "HH:mm"), 2))
    mins = Val(Right(Format(Time, "HH:mm"), 2))
    lngTime = 60 * hrs + mins
    Select Case lngTime
        Case Is <= 720
            strGreeting = "Good Morning"
        Case Is > 960
            strGreeting = "Good Evening"
        Case Else
            strGreeting = "Good Afternoon"
    End Select
    Set msg = Application.ActiveInspector.CurrentItem
    Set objRecip = Item.Recipients.Add("XXX@example.com")
    objRecip.Type = olBCC
    objRecip.Resolve
    End With
    msg.Body = strGreeting & vbCr & msg.Body
    If InStr(1, msg.Body, "attach", vbTextCompare) > 0 Then
        If msg.Attachments.Count = 0 Then
            If MsgBox("There's no attachment, send anyway?", vbYesNo) = vbNo then
                Cancel = True
            End If
        End If
    End If
    End Sub
    Remember To Do the Following....
    Use [Code].... [/Code] tags when posting code to the thread.
    Mark your thread as Solved if satisfied by using the Thread Tools options.
    If posting the same issue to another forum please show the link

  9. #9
    Maybe because I am using a personal (and not a business) email this worked for me.

    Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    
    
        Dim bccEmail As String
        
        If Item.SenderEmailAddress = "xxxxxxxxxxx@hotmail.com" Then
            bccEmail = "yyyyyyyyy@comcast.net"
            Item.BCC = bccEmail
        
        End If
        
    End Sub
    Attached Images Attached Images

  10. #10
    Moderator VBAX Wizard Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    5,183
    Location
    How can we add this is the the existing code?
    Remember To Do the Following....
    Use [Code].... [/Code] tags when posting code to the thread.
    Mark your thread as Solved if satisfied by using the Thread Tools options.
    If posting the same issue to another forum please show the link

  11. #11
    Just swap the msg out and use the Item directly. Again, I preface this as the Item.SenderEmailAddress isn't blank for me. I'm using office 365.

    Dim strGreeting
    Dim hrs As Long
    Dim mins As Long
    Dim lngTime As Long
    
    
    hrs = Val(Left(Format(Time, "HH:mm"), 2))
    mins = Val(Right(Format(Time, "HH:mm"), 2))
    lngTime = 60 * hrs + mins
    
    
    Select Case lngTime
    	Case Is <= 720
    		strGreeting = "Good Morning"
    	Case Is > 960
    		strGreeting = "Good Evening"
    	Case Else
    		strGreeting = "Good Afternoon"
    End Select
    strGreeting = "Good " & strGreeting
    
    
    If Item.SenderEmailAddress = "xxxx@yyyyy.co.uk" Then
    	Item.BCC = IIf(Len(Item.BCC) = 0, "" ,";") & "ttttttttt@gmail.com"
    End If
    
    
    strBody = Item.HTMLBody
    strBody = Replace(strBody, "Good day", strGreeting)
    Item.HTMLBody = strBody

  12. #12
    VBAX Contributor
    Joined
    Nov 2020
    Location
    Swansea,South Wales,UK
    Posts
    103
    Location
    Well this is embarrassing. Seems I was looking in the wrong folder.
    The Sent Items folder does indeed sync with all computers.

  13. #13
    VBAX Contributor
    Joined
    Nov 2020
    Location
    Swansea,South Wales,UK
    Posts
    103
    Location
    I am on 2007, and can get the BCC populated. Just that it does not seem to work. When sending the dialogue flashes a few times, and then I get the unable to send response, but with no addresses.

    All moot now, as I have found out the folder does sync after all.

    Quote Originally Posted by jdelano View Post
    Just swap the msg out and use the Item directly. Again, I preface this as the Item.SenderEmailAddress isn't blank for me. I'm using office 365.

    Dim strGreeting
    Dim hrs As Long
    Dim mins As Long
    Dim lngTime As Long
    
    
    hrs = Val(Left(Format(Time, "HH:mm"), 2))
    mins = Val(Right(Format(Time, "HH:mm"), 2))
    lngTime = 60 * hrs + mins
    
    
    Select Case lngTime
        Case Is <= 720
            strGreeting = "Good Morning"
        Case Is > 960
            strGreeting = "Good Evening"
        Case Else
            strGreeting = "Good Afternoon"
    End Select
    strGreeting = "Good " & strGreeting
    
    
    If Item.SenderEmailAddress = "xxxx@yyyyy.co.uk" Then
        Item.BCC = IIf(Len(Item.BCC) = 0, "" ,";") & "ttttttttt@gmail.com"
    End If
    
    
    strBody = Item.HTMLBody
    strBody = Replace(strBody, "Good day", strGreeting)
    Item.HTMLBody = strBody

  14. #14
    Moderator VBAX Wizard Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    5,183
    Location
    So it is Solved then?
    Remember To Do the Following....
    Use [Code].... [/Code] tags when posting code to the thread.
    Mark your thread as Solved if satisfied by using the Thread Tools options.
    If posting the same issue to another forum please show the link

  15. #15
    VBAX Contributor
    Joined
    Nov 2020
    Location
    Swansea,South Wales,UK
    Posts
    103
    Location
    Quote Originally Posted by Aussiebear View Post
    So it is Solved then?
    Yes. Sorry, I thought I had marked it solved when I found the correct location of the email address.
    Must have unmarked it when it was not sending.
    Now marked as Solved again.

  16. #16
    Moderator VBAX Wizard Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    5,183
    Location
    My apologies, I had marked it unsolved after you marked it solved because the thread seemed to roll on. All good here as it was an interesting thread.
    Remember To Do the Following....
    Use [Code].... [/Code] tags when posting code to the thread.
    Mark your thread as Solved if satisfied by using the Thread Tools options.
    If posting the same issue to another forum please show the link

Posting Permissions

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