View Single Post
  #1  
Old August 28th 08, 09:07 PM posted to microsoft.public.outlook.program_vba
lgwapnitsky
external usenet poster
 
Posts: 1
Default 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

Ads