none
Script para remover anexos de mensagens enviadas pelo outlook RRS feed

  • Pergunta

  • Olá.

      Preciso criar um script que verifique se o destinatário e ,se ele não constar em uma lista pré-determinada, o outlook remova o anexo do email, independente de que formato for esse anexo.

      Essa lista de destinatário preciso colocar em um arquivo txt que será somente leitura para que o usuário não possa alterar.

       Temos o winconnection 6 aqui na empresa,mas infelizmente ele apenas filtra tipos de anexo e não destinatários, portanto se eu conseguir fazer essa filtragem será pelo outlook mesmo.

       Temos várias versões de outlook 2003, 2007 e 2010 na rede, todas originais e devidamente registradas.

    Alguem tem idéia de como implementar?

    Att

    Alex

    quinta-feira, 14 de junho de 2012 17:59

Respostas

  • Cole o código abaixo na classe do objeto ThisOutlookSession do Outlook:

    Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
        
        If TypeName(Item) <> "MailItem" Then Exit Sub
        
        Dim sLista As String
        Dim iFreeFile As Integer
        Dim att As Attachment
    
        'Altere o caminho abaixo:
        sLista = "C:\temp\Lista.txt"
        
        iFreeFile = FreeFile
        Open sLista For Binary Access Read As iFreeFile
        sLista = Space(LOF(iFreeFile))
        Get 1, , sLista
        Close #1
        
        If InStr(1, sLista, Item.SenderEmailAddress) > 0 Then Exit Sub
        
        For Each att In Item.Attachments
            att.Delete
        Next att
        Item.Save
        
    End Sub


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    quinta-feira, 21 de junho de 2012 22:11
    Moderador

Todas as Respostas

  • O primeiro passo é você criar uma regra no Outlook para executar uma macro ao receber um e-mail. Para o Outlook 2010: http://www.ambienteoffice.com.br/outlook/executar_macro_ao_receber_e-mail/

    Em seguida, use o seguinte código no Outlook:

    Sub MensagemRecebida(Item As MailItem)
        Dim sLista As String
        Dim iFreeFile As Integer
        Dim att As Attachment
    
        'Altere o caminho abaixo:
        sLista = "C:\temp\Lista.txt"
        
        iFreeFile = FreeFile
        Open sLista For Binary Access Read As iFreeFile
        sLista = Space(LOF(iFreeFile))
        Get 1, , sLista
        Close #1
        
        If InStr(1, sLista, Item.SenderEmailAddress) > 0 Then Exit Sub
        
        For Each att In Item.Attachments
            att.Delete
        Next att
        Item.Save
        
    End Sub


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    domingo, 17 de junho de 2012 20:57
    Moderador
  • Felipe, boa tarde

    Vou tentar isso quando voltar ao cliente, mas não é quando chegarem os emails e sim quando eles saírem. Não quero que os usuários da rede enviem arquivos para qualquer um pois trabalhamos com arquivos confidenciais.

    Vou testar na proxima semana e posto o resultado aqui.

    quinta-feira, 21 de junho de 2012 20:59
  • Cole o código abaixo na classe do objeto ThisOutlookSession do Outlook:

    Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
        
        If TypeName(Item) <> "MailItem" Then Exit Sub
        
        Dim sLista As String
        Dim iFreeFile As Integer
        Dim att As Attachment
    
        'Altere o caminho abaixo:
        sLista = "C:\temp\Lista.txt"
        
        iFreeFile = FreeFile
        Open sLista For Binary Access Read As iFreeFile
        sLista = Space(LOF(iFreeFile))
        Get 1, , sLista
        Close #1
        
        If InStr(1, sLista, Item.SenderEmailAddress) > 0 Then Exit Sub
        
        For Each att In Item.Attachments
            att.Delete
        Next att
        Item.Save
        
    End Sub


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    quinta-feira, 21 de junho de 2012 22:11
    Moderador
  • Benzadeus... muito obrigado pela sua resposta.

    ola, não foi 100% correta sua ajuda mas bateu na trave e só precisou de alguns ajustes.

    Esse script que voce colocaou verifica o remetente e não o destinatário, então fiz alguns ajustes e o código ficou assim, 100% funcional.

    Como só precisou de um peque ajuste, o Crédito é todo Seu..  muito obrigado amigão

    Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
     'Solução sugerida por Felipe Costa Gualberto

    'Adaptado por Alex Augusto Felicioni

    'podem usar mas mantenham os creditos por favor 

    If TypeName(Item) <> "MailItem" Then Exit Sub
           Dim sLista As String
           Dim iFreeDestino As Integer
           Dim att As Attachment
          
    'aqui fica o caminho para o arquivo de endereços
        sLista = "c:\temp\Destinos.txt"
        iFreeDestino = FreeFile
        Open sLista For Binary Access Read As iFreeDestino
        sLista = Space(LOF(iFreeDestino))
        Get 1, , sLista
        Close #1
        If InStr(sLista, Item.To) > 0 Then Exit Sub
        For Each att In Item.Attachments
            att.Delete
            MsgBox ("O Anexo foi removido pois infringe as regras de email da Empresa")
        Next att
        Item.Save
    End Sub



    terça-feira, 17 de julho de 2012 17:38
  • Boa tarde,

    Senhores, gostaria de aplicar a regra apenas para a extensão .pdf, é possível? 

    quinta-feira, 14 de abril de 2016 20:40