Problem Emails System POPvsMX

<SCRIPT LANGUAGE="VBSCRIPT">
'
' For information about this namespace, see
'   http://msdn.microsoft.com/library/default.asp?url=/library/en-us/cdosys/html/_cdosys_schema_smtpenvelope.asp
'
Const RECIP_LIST = "http://schemas.microsoft.com/cdo/smtpenvelope/recipientlist"
'
' For information about the CdoEventStatus enumeration, see
'   http://msdn.microsoft.com/library/default.asp?url=/library/en-us/cdosys/html/_cdosys_cdoeventstatus_enum.asp
'
Const CDO_RUN_NEXT_SINK = 0
'
' OnArrival sink entry point
'
Sub ISMTPOnArrival_OnArrival(ByVal Msg, EventStatus)
  On Error Resume Next
  Dim objFields
  Set objFields = Msg.EnvelopeFields
  objFields(RECIP_LIST).Value = FixupRecipList(objFields(RECIP_LIST).Value)
  objFields.Update
  Msg.DataSource.Save ' Commit changes
  EventStatus = CDO_RUN_NEXT_SINK
End Sub
'
'  Change any @example.com recipient(s) to bob@company.com
'
Function FixupRecipList(strList)
  On Error Resume Next
  Dim strFixedList
  Dim nDomainPart
  Dim nNamePart
  Dim nNextAddress
  strFixedList = strList
  While (InStr(LCase(strFixedList),"@example.com"))
    nDomainPart = InStr(LCase(strFixedList),"@example.com")
    nNamePart = InStrRev(strFixedList,";",nDomainPart)
    nNextAddress = InStr(nDomainPart+Len("@example.com;"),strFixedList,"SMTP:")
    If (0 = nNamePart) Then
      ' @example.com is first name in recipient list
      If (0 = nNextAddress) Then
        ' @example.com is the last name in the recipient list
        strFixedList = "SMTP:bob@company.com;"
      Else
        ' @example.com is not the last name in the recipient list
        strFixedList = "SMTP:bob@company.com;" & Right(strFixedList,Len(strFixedList)-nNextAddress+1)
      End If
    Else
      ' @example.com is not the first name in recipient list
      If (0 = nNextAddress) Then
        ' @example.com is the last name in the recipient list
        strFixedList = Left(strFixedList,nNamePart) & "SMTP:bob@company.com;"
      Else
        ' @example.com is not the last name in the recipient list
        strFixedList = Left(strFixedList,nNamePart) & "SMTP:bob@company.com;" & Right(strFixedList,Len(strFixedList)-nNextAddress+1)
      End If
    End If
  Wend
  FixupRecipList = strFixedList
End Function


</SCRIPT>