Outlook VBA OTM Bcc based on group membership

[doucheface1]

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

[doucheface1]

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

[skatonni]

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/code-samples/use-vba-to-create-a-list-of-exchange-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/showthread.php?51476-quot-CC-quot-field-in-mail-has-to-be-filled-with-userform-s-variable-It-stays-empty