none
Code working fine in Outlook 2010 but not 2003 RRS feed

  • Question

  • I recently asked a question on these forums to warn if you are sending card numbers via email, and Graham Mayor kindly provided the below code. This worked nicely on Outlook 2010, however when I tried to use it on Outlook 2003 it doesn't appear to work.

    I've had a look around and people have mentioned using late binding to get around this issue. I've had no success in sorting this out myself, so any assistance would be appreciated. Obviously if there is an easier way to sort this out, that would be great. (Unfortunately upgrading is not a possibility!)

    As I mentioned it worked on Outlook 2010 with VBA 7 (with Microsoft Office 14 Object Library) but not on Outlook 2003 with VBA 6.5 and object library 11.

    Private Sub Application_ItemSend _
            (ByVal Item As Object, Cancel As Boolean)
    Dim strMsg As String
    Dim i As Long
    Dim strtext As String
    If AutomateReplyWithSearchString = True Then
        Cancel = True
        strMsg = "This message contains card or account numbers. Please remove before sending!"
        MsgBox strMsg, _
               vbExclamation + vbSystemModal, "Content Warning"
    End If
    Item.Display
    Set Item = Nothing
    End Sub

    and in an ordinary module, insert the following function code

    Function AutomateReplyWithSearchString() As Boolean
    Dim olInspector As Outlook.Inspector
    Dim olObject As Object
    Dim olItem As Outlook.MailItem
    Dim wdDoc As Object
    Dim strItem As String
    Dim bFound As Boolean
    Dim strMsg As String
    Dim oRng As Range
    Dim i As Long
    Dim vFindText As Variant

    vFindText = Array("[0-9]{4} [0-9]{4} [0-9]{4} [0-9]{4}", "[0-9]{5} / [0-9]{4}")

    Set olInspector = Application.ActiveInspector
    Set olObject = olInspector.CurrentItem

    If olObject.MessageClass = "IPM.Note" And _
       olInspector.IsWordMail = True Then
        Set olItem = olInspector.CurrentItem
        Set wdDoc = olInspector.WordEditor
        For i = 0 To UBound(vFindText)
            Set oRng = wdDoc.Range
            With oRng.Find
                Do While .Execute(FindText:=vFindText(i), MatchWildcards:=True) = True
                    AutomateReplyWithSearchString = True
                    Exit For
                Loop
            End With
        Next i
    End If
    Set olInspector = Nothing
    Set olObject = Nothing
    Set wdDoc = Nothing
    Set olItem = Nothing
    End Function

    Thanks in anticipation

    • Moved by Youen Zen Friday, October 12, 2012 6:29 AM Not VB issue (From:Visual Basic General)
    Thursday, October 11, 2012 7:18 PM

All replies

  • This forum is for VB in visual Studio Net

    Your problem is for VB for Application. 

    That has its own forum

    http://social.msdn.microsoft.com/Forums/en-US/isvvba


    Success
    Cor

    Thursday, October 11, 2012 9:49 PM
  • Oops! Thanks I'll repost
    Thursday, October 11, 2012 9:51 PM
  • I recently asked a question on these forums to warn if you are sending card numbers via email, and Graham Mayor kindly provided the below code. This worked nicely on Outlook 2010, however when I tried to use it on Outlook 2003 it doesn't appear to work.

    I've had a look around and people have mentioned using late binding to get around this issue. I've had no success in sorting this out myself, so any assistance would be appreciated. Obviously if there is an easier way to sort this out, that would be great. (Unfortunately upgrading is not a possibility!)

    As I mentioned it worked on Outlook 2010 with VBA 7 (with Microsoft Office 14 Object Library) but not on Outlook 2003 with VBA 6.5 and object library 11.

    Private Sub Application_ItemSend _
            (ByVal Item As Object, Cancel As Boolean)
    Dim strMsg As String
    Dim i As Long
    Dim strtext As String
    If AutomateReplyWithSearchString = True Then
        Cancel = True
        strMsg = "This message contains card or account numbers. Please remove before sending!"
        MsgBox strMsg, _
               vbExclamation + vbSystemModal, "Content Warning"
    End If
    Item.Display
    Set Item = Nothing
    End Sub

    and in an ordinary module, insert the following function code

    Function AutomateReplyWithSearchString() As Boolean
    Dim olInspector As Outlook.Inspector
    Dim olObject As Object
    Dim olItem As Outlook.MailItem
    Dim wdDoc As Object
    Dim strItem As String
    Dim bFound As Boolean
    Dim strMsg As String
    Dim oRng As Range
    Dim i As Long
    Dim vFindText As Variant

    vFindText = Array("[0-9]{4} [0-9]{4} [0-9]{4} [0-9]{4}", "[0-9]{5} / [0-9]{4}")

    Set olInspector = Application.ActiveInspector
    Set olObject = olInspector.CurrentItem

    If olObject.MessageClass = "IPM.Note" And _
       olInspector.IsWordMail = True Then
        Set olItem = olInspector.CurrentItem
        Set wdDoc = olInspector.WordEditor
        For i = 0 To UBound(vFindText)
            Set oRng = wdDoc.Range
            With oRng.Find
                Do While .Execute(FindText:=vFindText(i), MatchWildcards:=True) = True
                    AutomateReplyWithSearchString = True
                    Exit For
                Loop
            End With
        Next i
    End If
    Set olInspector = Nothing
    Set olObject = Nothing
    Set wdDoc = Nothing
    Set olItem = Nothing
    End Function

    Thanks in anticipation

    Thursday, October 11, 2012 9:55 PM
  • The code uses olInspector.WordEditor. In Outlook 2003, this is only valid if Word is used as e-mail editor. The code tests for this; the function AutomateReplyWithSearchString will always return False if Word is NOT used as e-mail editor.

    In Outlook 2007 and later, Word is ALWAYS used as e-mail editor, but in Outlook 2003 and earlier, users can choose between the built-in Outlook editor and Word.

    The following version of the function should work with the built-in editor too:

    Function AutomateReplyWithSearchString() As Boolean
        Dim olInspector As Outlook.Inspector
        Dim olObject As Object
        Dim olItem As Outlook.MailItem
        Dim strBody As String
        Dim i As Long
        Dim vFindText As Variant
    
        vFindText = Array("*[0-9][0-9][0-9][0-9] [0-9][0-9][0-9][0-9] " & _
            "[0-9][0-9][0-9][0-9] [0-9][0-9][0-9][0-9]*", _
            "*[0-9][0-9][0-9][0-9][0-9] / [0-9][0-9][0-9][0-9]*")
    
        Set olInspector = Application.ActiveInspector
        Set olObject = olInspector.CurrentItem
    
        If olObject.MessageClass = "IPM.Note" Then
            Set olItem = olInspector.CurrentItem
            strBody = olItem.Body
            For i = 0 To UBound(vFindText)
                If strBody Like vFindText(i) Then
                    AutomateReplyWithSearchString = True
                    Exit For
                End If
            Next i
        End If
    
        Set olInspector = Nothing
        Set olObject = Nothing
        Set olItem = Nothing
    End Function


    Regards, Hans Vogelaar

    Thursday, October 11, 2012 10:35 PM
  • Thanks Hans, that is very useful. I will try it tomorrow morning and let you know how I get on.

    Thursday, October 11, 2012 10:50 PM
  • Hi Hans,

    This is working fine apart from when I tried to accept a meeting invite. I received the error message:

    "Run-time error '91': Object variable or With block variable not set"

    If I select debug it highlights the following code:

    Set olObject = olInspector.CurrentItem

    I think I tried something a little too complicated considering my minimal knowledge!!

    Thanks again for taking the time to look at this for me

    Monday, October 15, 2012 7:37 PM
  • Perhaps this version of the function?

    Function AutomateReplyWithSearchString() As Boolean
        Dim olInspector As Outlook.Inspector
        Dim olObject As Object
        Dim olItem As Outlook.MailItem
        Dim strBody As String
        Dim i As Long
        Dim vFindText As Variant
    
        On Error GoTo ErrHandler
    
        vFindText = Array("*[0-9][0-9][0-9][0-9] [0-9][0-9][0-9][0-9] " & _
            "[0-9][0-9][0-9][0-9] [0-9][0-9][0-9][0-9]*", _
            "*[0-9][0-9][0-9][0-9][0-9] / [0-9][0-9][0-9][0-9]*")
    
        Set olInspector = Application.ActiveInspector
        Set olObject = olInspector.CurrentItem
    
        If olObject.MessageClass = "IPM.Note" Then
            Set olItem = olInspector.CurrentItem
            strBody = olItem.Body
            For i = 0 To UBound(vFindText)
                If strBody Like vFindText(i) Then
                    AutomateReplyWithSearchString = True
                    Exit For
                End If
            Next i
        End If
    
    ExitHandler:
        Set olInspector = Nothing
        Set olObject = Nothing
        Set olItem = Nothing
        Exit Function
    
    ErrHandler:
        If Err <> 91 Then
            MsgBox Err.Description, vbExclamation
        End If
        Resume ExitHandler
    End Function


    Regards, Hans Vogelaar

    Monday, October 15, 2012 8:58 PM
  • Hi Hans,

    Thanks for the follow up code. This appeared to be working well, but today I noticed some unusual behaviour.

    When I try to send a meeting invite, it sends it and then opens up another window as if it is confirming the details, or if I had sent it to myself. Removing the function still gives this behaviour, so presumably it is the sub that is causing this 'irritation'. I can't get my head around why this is happening, but maybe I should put something in the sub to ignore anything related to a calender item. (I'm not worried about these being scanned anyway)

    Thanks again

    Wednesday, October 17, 2012 8:45 PM
  • Does this version of the event procedure work better?

    Private Sub Application_ItemSend _
             (ByVal Item As Object, Cancel As Boolean)
        Dim strMsg As String
        Dim i As Long
        Dim strtext As String
        If AutomateReplyWithSearchString = True Then
            Cancel = True
            strMsg = "This message contains card or account numbers. " &_
                "Please remove before sending!"
            MsgBox strMsg, _
                vbExclamation + vbSystemModal, "Content Warning"
            Item.Display
        End If
        Set Item = Nothing
    End Sub


    Regards, Hans Vogelaar

    Wednesday, October 17, 2012 10:28 PM
  • Hi Hans,

    thanks, this does seem to solve the issue with the calender items.

    One last thing I was considering was a way of allowing an email to send if there was a false positive. My theory was to include an 'are you sure' Yes / No box instead of the information box which I managed to input into the code previously. Unfortunately now with you solving the above, I can't get the VBA.vbYesNo message box to work. Now both boxes were preventing the send.

    I appreciate you helping me with this project.

    Thursday, October 18, 2012 2:28 PM
  • Try this version:

    Private Sub Application_ItemSend _
             (ByVal Item As Object, Cancel As Boolean)
        Dim strMsg As String
        If AutomateReplyWithSearchString = True Then
            strMsg = "This message contains card or account numbers." & _
                vbCrLf & "Would you like to remove them before sending?"
            If MsgBox(strMsg, vbYesNo + vbQuestion, _
                    "Content Warning") = vbYes Then
                Cancel = True
                Item.Display
            End If
        End If
        Set Item = Nothing
    End Sub


    Regards, Hans Vogelaar

    Thursday, October 18, 2012 2:52 PM