Modifying the To, CC and BCC fields
 

I am trying to write a VBA script that parses the above-mentioned fields and
removes certain groups based on user response. My code works up until the
point where I'm ready to send the message, at which point I get a message
station "Operation has failed".

I am a farily new VBA programmer, so I know my code is a bit sloppy.

Thanks,
Larry


Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

' Definitions

Dim objOL As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim objList As Outlook.AddressList
Dim objEntry As Outlook.AddressEntry
Dim objEXDL As Outlook.ExchangeDistributionList
Set objOL = Application
Set objNS = objOL.Session
Set objList = objNS.GetGlobalAddressList

Dim ListName As String
Dim GAL() As String
Dim GAL_Split As String
Dim GALCount
GALCount = 0

Dim ToLine() As String
Dim MTL() As String
Dim CCLine() As String
Dim MCC() As String
Dim TempData As String
Dim ModNum As Integer

Dim KeepRecipient As Integer

' start programming

For Each objEntry In objList.AddressEntries
If objEntry.AddressEntryUserType =
olExchangeDistributionListAddressEntry Then
Set objEXDL = objEntry.GetExchangeDistributionList
ReDim Preserve GAL(GALCount + 1)
GAL(GALCount) = objEXDL
GALCount = GALCount + 1
End If
Next

GAL_Split = Join(GAL, "; ")


' Handle the TO: line
ModNum = 0

ToLine = Split(Item.To, "; ")

For i = 0 To UBound(ToLine)

TempData = ToLine(i)
Select Case InStr(GAL_Split, TempData)
Case 0
ReDim Preserve MTL(ModNum + 1)
MTL(ModNum) = TempData
ModNum = ModNum + 1
Case Else
If InStr(GAL_Split, TempData) Then
KeepRecipient = MsgBox("Are you sure you want to
send" & vbCrLf _
& "this message to " & TempData & "?", _
vbQuestion + vbYesNo + vbDefaultButton2)
If KeepRecipient = vbYes Then
ReDim Preserve MTL(ModNum + 1)
MTL(ModNum) = TempData
ModNum = ModNum + 1
End If
End If
End Select

i = i + 1
'Loop
Next



' Handle the CC: line
ModNum = 0

CCLine = Split(Item.CC, "; ")

For i = 0 To UBound(CCLine)

TempData = CCLine(i)
Select Case InStr(GAL_Split, TempData)
Case 0
ReDim Preserve MCC(ModNum + 1)
MCC(ModNum) = TempData
ModNum = ModNum + 1
Case Else
If InStr(GAL_Split, TempData) Then
KeepRecipient = MsgBox("Are you sure you want to
send" & vbCrLf _
& "this message to " & TempData & "?", _
vbQuestion + vbYesNo + vbDefaultButton2)
If KeepRecipient = vbYes Then
ReDim Preserve MCC(ModNum + 1)
MCC(ModNum) = TempData
ModNum = ModNum + 1
End If
End If
End Select

i = i + 1

Next


Item.To = Join(MTL, "; ")
Item.CC = Join(MCC, "; ")
Item.Display
'Cancel = True







'' Do not delete below this line

If Item.Subject = "" Then
Cancel = True
MsgBox "You forgot to enter a subject.", _
vbExclamation + vbSystemModal, "Missing Subject"
Item.Display
End If

End Sub

Modifying the To, CC and BCC fields
 

As I seem to recall if you're sending to more than one receipient, you have
to use the receiptent(sp) collection and then set to the .To to the
collection.

See this article...
http://msdn.microsoft.com/en-us/libr...ffice.11).aspx


"lgwapnitsky" wrote:

I am trying to write a VBA script that parses the above-mentioned fields and
removes certain groups based on user response. My code works up until the
point where I'm ready to send the message, at which point I get a message
station "Operation has failed".

I am a farily new VBA programmer, so I know my code is a bit sloppy.

Thanks,
Larry


Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

' Definitions

Dim objOL As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim objList As Outlook.AddressList
Dim objEntry As Outlook.AddressEntry
Dim objEXDL As Outlook.ExchangeDistributionList
Set objOL = Application
Set objNS = objOL.Session
Set objList = objNS.GetGlobalAddressList

Dim ListName As String
Dim GAL() As String
Dim GAL_Split As String
Dim GALCount
GALCount = 0

Dim ToLine() As String
Dim MTL() As String
Dim CCLine() As String
Dim MCC() As String
Dim TempData As String
Dim ModNum As Integer

Dim KeepRecipient As Integer

' start programming

For Each objEntry In objList.AddressEntries
If objEntry.AddressEntryUserType =
olExchangeDistributionListAddressEntry Then
Set objEXDL = objEntry.GetExchangeDistributionList
ReDim Preserve GAL(GALCount + 1)
GAL(GALCount) = objEXDL
GALCount = GALCount + 1
End If
Next

GAL_Split = Join(GAL, "; ")


' Handle the TO: line
ModNum = 0

ToLine = Split(Item.To, "; ")

For i = 0 To UBound(ToLine)

TempData = ToLine(i)
Select Case InStr(GAL_Split, TempData)
Case 0
ReDim Preserve MTL(ModNum + 1)
MTL(ModNum) = TempData
ModNum = ModNum + 1
Case Else
If InStr(GAL_Split, TempData) Then
KeepRecipient = MsgBox("Are you sure you want to
send" & vbCrLf _
& "this message to " & TempData & "?", _
vbQuestion + vbYesNo + vbDefaultButton2)
If KeepRecipient = vbYes Then
ReDim Preserve MTL(ModNum + 1)
MTL(ModNum) = TempData
ModNum = ModNum + 1
End If
End If
End Select

i = i + 1
'Loop
Next



' Handle the CC: line
ModNum = 0

CCLine = Split(Item.CC, "; ")

For i = 0 To UBound(CCLine)

TempData = CCLine(i)
Select Case InStr(GAL_Split, TempData)
Case 0
ReDim Preserve MCC(ModNum + 1)
MCC(ModNum) = TempData
ModNum = ModNum + 1
Case Else
If InStr(GAL_Split, TempData) Then
KeepRecipient = MsgBox("Are you sure you want to
send" & vbCrLf _
& "this message to " & TempData & "?", _
vbQuestion + vbYesNo + vbDefaultButton2)
If KeepRecipient = vbYes Then
ReDim Preserve MCC(ModNum + 1)
MCC(ModNum) = TempData
ModNum = ModNum + 1
End If
End If
End Select

i = i + 1

Next


Item.To = Join(MTL, "; ")
Item.CC = Join(MCC, "; ")
Item.Display
'Cancel = True







'' Do not delete below this line

If Item.Subject = "" Then
Cancel = True
MsgBox "You forgot to enter a subject.", _
vbExclamation + vbSystemModal, "Missing Subject"
Item.Display
End If

End Sub

Modifying the To, CC and BCC fields
 

Instead of posting what appears to be the whole code, why not just
post the relevant section that is giving you trouble, state at exactly
what line the code bombs, and explain the outcome you are looking
for, so we can more easily pinpoint exactly what is needed.

Thx,
JP

On Aug 28, 4:07*pm, lgwapnitsky
wrote:
I am trying to write a VBA script that parses the above-mentioned fields and
removes certain groups based on user response. *My code works up until the
point where I'm ready to send the message, at which point I get a message
station "Operation has failed".

I am a farily new VBA programmer, so I know my code is a bit sloppy. *

Thanks,
Larry

* * Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)