Author Topic: [VBA] Macro per rilevare gli allegati mancanti Outlook 2010  (Read 9317 times)

0 Members and 1 Guest are viewing this topic.

Offline Raid

  • Administrator
  • Membro esperto
  • *****
  • Posts: 2200
    • www.darkforge.it
[VBA] Macro per rilevare gli allegati mancanti Outlook 2010
« on: Fri 21 February 2014, 22:00 »
Mettere in ThisOutlookSession

Code: [Select]
'SUB per verificare la presenza della parola ALLEG e ATTACH nel messaggio
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

'per il codice che cerca ALLEG
Dim answer As Variant

'per il codice che cerca ATTACH
Dim lngPos As Long
Dim strText As String
Dim strSearchText As String
Dim lngStringCount As Long
lngPos = 1
lngStringCount = 0
   
'Facciamo prima cercare gli allegati
   If InStr(1, Item.Body, "alleg", vbTextCompare) > 0 Then
        If Item.Attachments.count = 0 Then
          answer = MsgBox("E' stato rilevata la parola Allegato ma non è presente nessun allegato, inviare comunque?", vbYesNo)
            If answer = vbNo Then
                Cancel = True
            End If
        End If
'Se non ci sono allegati, cerchiamo gli attachments
    Else
        Do
            lngPos = InStr(lngPos, Item.Body, "attach")
            If lngPos > 0 Then
                lngStringCount = lngStringCount + 1
                lngPos = lngPos + Len("alleg")
            End If
        Loop Until lngPos = 0

        'MsgBox lngStringCount & " occorrenze"

' >3 perchè nella firma compare 3 volte quindi devo ignorare le prime 3 volte       
        If lngStringCount > 3 Then
            answer = MsgBox("E' stato rilevata la parola Attachment ma non è presente nessun allegato, inviare comunque?", vbYesNo)
            If answer = vbNo Then
                Cancel = True
            End If
        End If

    End If

End Sub

 

Creative Commons License All ValerioCipriani.com contents are published according to Creative Common License, except different instructions. The Staff is not responsible of eventually guide, article and publishing mistakes. All published items are patent free. All trade marks reported are right reserved. Contact us, Info.