Modifying the To, CC and BCC fields

  • Thread starter Thread starter lgwapnitsky
  • Start date Start date
L

lgwapnitsky

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
 
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
 
Back
Top