Envoi automatique d'un email après modification

Bonjour, je me permets de poster sur ce forum car j'avoue ne pas être très doué en VBA.

Alors voilà, j'ai la feuille de caisse de mon magasin et ma fiche de suivi client qui sont toutes deux actives.

Ce que j'aimerai, c'est recevoir un mail après qu'une modification est été apportée à l'une ou l'autre feuille et que dans ce mail il y ait les feuilles actives en PDF.

J'ai actuellement ceci qui me prévient en cas de modification:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

Dim ol As Object, monmail As Object
DisplayAlerts = False
Set ol = CreateObject("outlook.application")
Set monmail = ol.CreateItem(olMailItem)
monmail.To = "--"
monmail.Subject = "Modifs"
monmail.Body = "Modifications apportees dans le fichier"
monmail.Send
Set ol = Nothing
End Sub

Merci d'avance pour votre aide.

Bon bah j'ai réussi tout seul en compilant plusieurs codes et je ne suis pas peu fier du résultat sachant que je suis une brelle en vba.

Voici le code:

Sub AttachActiveSheetPDF()
  Dim IsCreated As Boolean
  Dim i As Long
  Dim PdfFile As String, Title As String
  Dim OutlApp As Object
  Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

  ' Not sure for what the Title is
  Title = Range("A1")

  ' Define PDF filename
  PdfFile = ActiveWorkbook.FullName
  i = InStrRev(PdfFile, ".")
  If i > 1 Then PdfFile = Left(PdfFile, i - 1)
  PdfFile = PdfFile & "_" & ActiveSheet.Name & ".pdf"

  ' Export activesheet as PDF
  With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  End With

  ' Use already open Outlook if possible
  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = True
  End If
  OutlApp.Visible = True
  On Error GoTo 0

  ' Prepare e-mail with PDF attachment
  With OutlApp.CreateItem(0)

    ' Prepare e-mail
    .Subject = Title
    .To = "--" ' <-- Put email of the recipient here
    .CC = "--" ' <-- Put email of 'copy to' recipient here
    .Body = "Hi," & vbLf & vbLf _
          & "The report is attached in PDF format." & vbLf & vbLf _
          & "Regards," & vbLf _
          & Application.UserName & vbLf & vbLf
    .Attachments.Add PdfFile

    ' Try to send
    On Error Resume Next
    .Send
    Application.Visible = True

    On Error GoTo 0

  End With

  ' Delete PDF file
  Kill PdfFile

  ' Quit Outlook if it was created by this code
  If IsCreated Then OutlApp.Quit

  ' Release the memory of object variable
  Set OutlApp = Nothing

End Sub

J'ai du autoriser le lancement automatique des macros sur le dossier qui contient le fichier pour éviter de le faire manuellement à chaque ouverture du fichier.

Ce qui m’embête maintenant, c'est que le script se lance qu'en je sauvegarde manuellement et j'aimerai qu'il se lance automatiquement toutes 15 minutes. J'ai testé plusieurs bout de code mais sans succès.

Bonjour à tous (même si j'ai plutôt l'impression de me parler à moi même).

Voilà donc mon code marche parfaitement, toutefois, vu qu'il y a régulièrement des modifications faites sur ce fichier, je me retrouve avec des dizaines de mails.

J'aurai souhaité recevoir à la place un mail toutes les 30 minutes. J'ai déjà fait des essais mais malheureusement, ça n'a rien donné.

Mon code actuel:

Sub AttachActiveSheetPDF()
  Dim IsCreated As Boolean
  Dim i As Long
  Dim PdfFile As String, Title As String
  Dim OutlApp As Object
   ActiveWorkbook.Save
    Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

   ' Not sure for what the Title is
  Title = Range("O16")

  ' Define PDF filename
  PdfFile = ActiveWorkbook.FullName
  i = InStrRev(PdfFile, ".")
  If i > 1 Then PdfFile = Left(PdfFile, i - 1)
  PdfFile = PdfFile & "_" & ActiveSheet.Name & ".pdf"

  ' Export activesheet as PDF
  With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  End With

  ' Use already open Outlook if possible
  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = True
  End If
  OutlApp.Visible = True
  On Error GoTo 0

  ' Prepare e-mail with PDF attachment
  With OutlApp.CreateItem(0)

    ' Prepare e-mail
    .Subject = Title
    .To = "--" ' <-- Put email of the recipient here
    .CC = "--" ' <-- Put email of 'copy to' recipient here
    .Body = "Hi," & vbLf & vbLf _
          & "The report is attached in PDF format." & vbLf & vbLf _
          & "Regards," & vbLf _
          & Application.UserName & vbLf & vbLf
    .Attachments.Add PdfFile

    ' Try to send
    On Error Resume Next
    .Send
    Application.Visible = True

    On Error GoTo 0

  End With

  ' Delete PDF file
  Kill PdfFile

  ' Quit Outlook if it was created by this code
  If IsCreated Then OutlApp.Quit

  ' Release the memory of object variable
  Set OutlApp = Nothing

End Sub

Je pense devoir ajouter ceci dans le workbook:

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Application.OnTime Now + TimeValue("00:30:00"), "EnregistrerFichier"
    End Sub

Et ceci dans le module :

  Sub EnregistrerFichier()
    ActiveWorkbook.Save
    End Sub

Mais j'avoue ne pas savoir comment l'intégrer à mon code.