none
Outlook Macro RRS feed

  • Question

  • Hi Team,

    Below mentioned code working fine, I can not delete or modify any attachment in email. However, This code is not allowing me to send new email to the recipient. Please help me to modify the current code so that I can send a new email with the same working as this code is doing.

    Option Explicit

    Public WithEvents myItem As Outlook.MailItem

    Private Sub Application_ItemLoad(ByVal Item As Object)

    If Item.Class = olMail Then
            Set myItem = Item
        End If
    End Sub


    Private Sub myItem_Write(Cancel As Boolean)
    MsgBox "You are not allowed to save "
    Cancel = True
    myItem.Close olDiscard
    End Sub

    Public Sub Initalize_Handler()

    Const strCancelEvent = "Application-defined or object-defined error"
    Set myItem = Application.ActiveInspector.CurrentItem
    End Sub

    • Moved by Perry-Pan Monday, July 9, 2018 4:39 AM
    Friday, July 6, 2018 10:47 PM

Answers

  • Hello Ankit Singh Jadon,

    You current code will prevent any update for the mail. I would suggest you make some condition so it will only prevent when these conditions meet.

    I would suggest you use AttachmentAdd and AttachmentRemove event to set a flag that the mail should be prevent to save.

    Here is the simple code.

    Public WithEvents myItem As Outlook.MailItem
    Dim flag As Boolean
    
    Private Sub Application_ItemLoad(ByVal Item As Object)
    
    If Item.Class = olMail Then
            flag = False
            Set myItem = Item
        End If
    End Sub
    
    Private Sub myItem_AttachmentAdd(ByVal Attachment As Attachment)
    flag = True
    End Sub
    
    Private Sub myItem_AttachmentRemove(ByVal Attachment As Attachment)
    flag = True
    End Sub
    
    
    Private Sub myItem_Write(Cancel As Boolean)
    If flag Then
    MsgBox "You are not allowed to save "
    Cancel = True
    myItem.Close olDiscard
    End If
    End Sub

    Best Regards,

    Terry


    MSDN Community Support
    Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

    Monday, July 9, 2018 6:02 AM

All replies

  • Hi,

    As this issue is more related with macro, I'll help move this case to Outlook for Developer forum to get a better response.

    Thank you for your understanding and support.

    Regards,

    Perry


    Please remember to mark the replies as answers if they helped. If you have feedback for TechNet Subscriber Support, contact tnsf@microsoft.com.


    Click here to learn more. Visit the dedicated forum to share, explore and talk to experts about Microsoft Teams.

    Monday, July 9, 2018 4:38 AM
  • Hello Ankit Singh Jadon,

    You current code will prevent any update for the mail. I would suggest you make some condition so it will only prevent when these conditions meet.

    I would suggest you use AttachmentAdd and AttachmentRemove event to set a flag that the mail should be prevent to save.

    Here is the simple code.

    Public WithEvents myItem As Outlook.MailItem
    Dim flag As Boolean
    
    Private Sub Application_ItemLoad(ByVal Item As Object)
    
    If Item.Class = olMail Then
            flag = False
            Set myItem = Item
        End If
    End Sub
    
    Private Sub myItem_AttachmentAdd(ByVal Attachment As Attachment)
    flag = True
    End Sub
    
    Private Sub myItem_AttachmentRemove(ByVal Attachment As Attachment)
    flag = True
    End Sub
    
    
    Private Sub myItem_Write(Cancel As Boolean)
    If flag Then
    MsgBox "You are not allowed to save "
    Cancel = True
    myItem.Close olDiscard
    End If
    End Sub

    Best Regards,

    Terry


    MSDN Community Support
    Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

    Monday, July 9, 2018 6:02 AM
  • Hi Terry,

    Below mentioned Code is working fine. However, I have to run below mentioned code manually. It's not getting run automatically while opening outlook. Please Please help so that it can run automatically while opening outlook.

    Public WithEvents myItem As Outlook.MailItem

    Dim flag As Boolean

    Private Sub Application_ItemLoad(ByVal Item As Object)

    If Item.Class = olMail Then

            flag = False

            Set myItem = Item

        End If

    End Sub

    Private Sub myItem_AttachmentAdd(ByVal Attachment As Attachment)

    flag = False

    End Sub

    Private Sub myItem_AttachmentRemove(ByVal Attachment As Attachment)

    flag = True

    End Sub

    Private Sub myItem_BeforeAttachmentSave(ByVal myAttachment As Attachment, Cancel As Boolean)

     

    flag = True

    'MsgBox "You are not allowed to save " & myAttachment.FileName

    End Sub

    Private Sub myItem_Write(Cancel As Boolean)

    If flag Then

    Cancel = True

    MsgBox "You are not allowed to save "

    myItem.Close olDiscard

    Else

    End If

    End Sub

    Public Sub Initalize_Handler()

    Const strCancelEvent = "Application-defined or object-defined error"

    Set myItem = Application.ActiveInspector.CurrentItem

    End Sub

    Tuesday, July 10, 2018 2:36 PM