question

xxtomsonxx-4976 avatar image
0 Votes"
xxtomsonxx-4976 asked xxtomsonxx-4976 published

VBA macro Outlook - accepting every attachment before sending message

Hello,

Is it possible to check by macro in Oulootk if email contains any attachment, and if so, prompt for accept or deny attachment before sending the message ?
The same for all "send to" addresses. Before sending the email, prompt for every address for accepting?

Thx in advance!

office-outlook-itprooffice-vba-dev
5 |1600 characters needed characters left characters exceeded

Up to 10 attachments (including images) can be used with a maximum of 3.0 MiB each and 30.0 MiB total.

1 Answer

kinuasa avatar image
0 Votes"
kinuasa answered xxtomsonxx-4976 published

Hi,
I recommend to use the (Application).ItemSend event.

 'ThisOutlookSession
 Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
   Dim msg As String
   Dim att As Outlook.Attachment
      
   If TypeOf Item Is Outlook.MailItem Then
     If Item.Attachments.Count > 0 Then
       msg = "This message contains the following attachments." & vbNewLine & _
             "Do you want to send it as it is?" & vbNewLine
       For Each att In Item.Attachments
         msg = msg & vbNewLine & "* " & att.FileName
       Next
       If MsgBox(msg, vbQuestion + vbSystemModal + vbYesNo) = vbNo Then Cancel = True
     End If
   End If
 End Sub


· 1
5 |1600 characters needed characters left characters exceeded

Up to 10 attachments (including images) can be used with a maximum of 3.0 MiB each and 30.0 MiB total.

Hi Kinuasa,


Thank you for response. I managed to create it by my own. I added also the name of attachment in MsgBox and deleting the file from message, while the vbNo is pressed:

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

If Item.Attachments.Count > 0 Then
For i = Item.Attachments.Count To 1 Step -1
Set oAtt = Item.Attachments.Item(i)
If oAtt.Size > 5200 Then
answer = MsgBox("Do you want to send:" & oAtt.FileName & "?", vbQuestion + vbYesNo)
If answer = vbNo Then
oAtt.Delete
End If
End If
Next i
Item.Save
End If

Have a nice day!

0 Votes 0 ·