Consulting

Results 1 to 3 of 3

Thread: Outlook VBA OTM Bcc based on group membership

  1. #1

    Cool Outlook VBA OTM Bcc based on group membership

    I've been tasked with modifying an outlook OTM file that currently ask the users a question when sending mail

    The OTM file asks the users if they would like to send a copy of the mail there sending to a predefined mailbox (BCC)

    What I need to do is change the script so it reads group membership of the user and based on the group membership gives them a drop down box. this drop down will give them a choice of mailboxes to BCC the mail to.
    for example

    If user A is a member of group Domain\projectA and domain\ProjectB then the dropdown would give the user the drop down box when sending a mail to choose between the projectA and Project B mailboxes for Bcc.

    Is the above possible?

    the current OTMfile has the below code in it.



    I hope this is possible

    Thanks chris

  2. #2
    Sub DateStamp()
    'by simon rickell
      Dim objApp As Application
      Dim objItems As Object
      Dim objItem As Object
      Dim objNS As NameSpace
      Set objApp = CreateObject("Outlook.Application")
      Set objNS = objApp.GetNamespace("MAPI")
      Set objItems = objApp.ActiveExplorer.Selection
      For Each objItem In objItems
      If objItem.Class = olMail Then
        If Left$(objItem.Subject, Len(objItem.SentOn)) <> Format(objItem.SentOn, "YYYY-MM-DD HH:MM:SS") Then
        
          objItem.Subject = Format(objItem.SentOn, "YYYY-MM-DD HH:MM:SS") & "-" & objItem.Subject
          objItem.Save
        End If
      End If
      
      Next
      
      
      Set objItem = Nothing
      Set objNS = Nothing
      Set objApp = Nothing
    End Sub
    
    Sub Create_Button()
        Dim cbTesting As CommandBar
        Dim ctlCBarButton As CommandBarButton
        Dim ctlCBarCombo As CommandBarComboBox
        Dim ctlCBarPopup As CommandBarPopup
        On Error Resume Next
        Set cbTesting = Application.ActiveExplorer.CommandBars("Shepherd")
        If Err = 0 Then
            cbTesting.Delete
        End If
        Set cbTesting = Application.ActiveExplorer.CommandBars _
            .Add(Name:="Shepherd", Position:=msoBarTop)
        Set ctlCBarButton = cbTesting.Controls.Add(Type:=msoControlButton)
        With ctlCBarButton
            .Caption = "Date Stamp"
            .FaceId = 2167
            .Style = msoButtonCaption
            .Visible = True
            .OnAction = "Project1.ThisOutlookSession.DateStamp"
            .TooltipText = "Date stamp an item of mail with the received date"
        End With
        cbTesting.Visible = True
    End Sub
     
    Sub CCProjMail()
    'by Allan Scott
    Sub Application_ItemSend(ByVal MailItem As Object, Cancel As Boolean)
        Dim projMail As String
        Dim ask As String
        ask = MsgBox("Send a copy to 'Computer Helpdesk' Project Mail Box?", _
        vbYesNo + vbQuestion, "Project eMail")
        If ask = vbNo Then
        'Resolve the address
        MailItem.Recipients.ResolveAll
        MsgBox ("Your email will be sent as normal"), vbOKOnly + vbInformation
        Else: ask = vbYes
        projMail = ("")
        MailItem.CC = MailItem.CC & ";" & projMail
        'Resolve the address
        MailItem.Recipients.ResolveAll
        MsgBox ("Your email will be sent with a copy sent to 'Computer Helpdesk' Project Mail Box"), _
        vbOKOnly + vbInformation
        
    End If
    End Sub

  3. #3
    VBAX Mentor skatonni's Avatar
    Joined
    Jun 2006
    Posts
    347
    Location
    Appears the only relevant code is Application_ItemSend.

    Sub Application_ItemSend(ByVal MailItem As Object, Cancel As Boolean) 
            Dim projMail As String 
            Dim ask As String 
            ask = MsgBox("Send a copy to 'Computer Helpdesk' Project Mail Box?", _ 
            vbYesNo + vbQuestion, "Project eMail") 
            If ask = vbNo Then 
                 'Resolve the address
                MailItem.Recipients.ResolveAll 
                MsgBox ("Your email will be sent as normal"), vbOKOnly + vbInformation 
            Else: ask = vbYes 
                projMail = ("") 
                MailItem.CC = MailItem.CC & ";" & projMail 
                 'Resolve the address
                MailItem.Recipients.ResolveAll 
                MsgBox ("Your email will be sent with a copy sent to 'Computer Helpdesk' Project Mail Box"), _ 
                vbOKOnly + vbInformation 
                 
            End If 
        End Sub
    I suggest you will start Application_ItemSend from scratch.

    I do not think you can get to "Member Of" information with VBA. If true, you will have to know the group and check all the members to see if the sender is included. To check for membership in groups. http://www.slipstick.com/developer/c...e-gal-members/

    This code is slow. It will be high maintenance having to be updated with every new project.

    Sub GetDGMembers()
     
    Dim olApp As Outlook.Application
    Dim olNS As Outlook.NameSpace
    Dim olAL As Outlook.AddressList
    Dim olEntry As Outlook.AddressEntry
    Dim olMember As Outlook.AddressEntry
    Dim lMemberCount As Long
    Dim objMail As Outlook.MailItem
     
    Set olApp = Outlook.Application
    Set olNS = olApp.GetNamespace("MAPI")
    Set olAL = olNS.AddressLists("Global Address List")
     
    Set objMail = olApp.CreateItem(olMailItem)
     
    ' enter the list name
    Set olEntry = olAL.AddressEntries("Advertiser Inquiries") 
     
    ' get count of dist list members
    lMemberCount = olEntry.Members.Count
     
    ' loop through dist list and extract members
    Dim i As Long
    For i = 1 To lMemberCount
      Set olMember = olEntry.Members.Item(i)
      strName = olMember.Name
      strAddress = olMember.GetExchangeUser.PrimarySmtpAddress
      strPhone = olMember.GetExchangeUser.BusinessTelephoneNumber
       
      objMail.Body = objMail.Body & strName & " -- " & strAddress & " -- " & strPhone & vbCrLf
    Next i
     
    objMail.Display
     
    End Sub
    Each sender will need a userform.

    This describes a userform with a list. http://www.vbaexpress.com/kb/getarticle.php?kb_id=303 You will likely want to fill the list with applicable project addresses rather than a static set of addresses.

    This demonstrates how to pass an address back to a mailitem. http://www.vbaexpress.com/forum/show...It-stays-empty
    To debug, mouse-click anywhere in the code. Press F8 repeatedly to step through the code. http://www.cpearson.com/excel/DebuggingVBA.aspx

    If your problem has been solved in your thread, mark the thread "Solved" by going to the "Thread Tools" dropdown at the top of the thread. You might also consider rating the thread by going to the "Rate Thread" dropdown.

Posting Permissions

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