Outlook-VBA envoie automatique mail avec piece jointe [Résolu/Fermé]

Signaler
Messages postés
172
Date d'inscription
mercredi 7 décembre 2016
Statut
Membre
Dernière intervention
27 mars 2018
-
Messages postés
172
Date d'inscription
mercredi 7 décembre 2016
Statut
Membre
Dernière intervention
27 mars 2018
-
Bonjour a tous,

J' ai vu que le sujet est traité plusieurs fois sous différents angles... Mais je n´ai pas trouvé mon bonheur.

Ma problématique est envoyer un mail a différents destinataire avec comme piece jointe un document sur le réseau interne.

Je n´y connais pas grand chose a Outlook, mais il doit etre possible de faire du VBA pour automatiser cette tache?!

Je connais un peu de VBA et je serais le faire sous excel (j´ai testé avec tache planifiée sans succés pour le l ´envoie a l´ouverture du document), mais je souhaiterais le faire avec Outlook, depuis le temps que j´y suis... J´ai fait des tests depuis le formulaire et modifier son script, mais je ne comprends pas trop.

Je me demande s´il n´existe pas un évenement du genre: Workbook_Open sur outlook ou comment ca marche?

Si quelquún a des pistes ou meme la solution je suis prenneur et je le remercie par avence!

1 réponse

Messages postés
172
Date d'inscription
mercredi 7 décembre 2016
Statut
Membre
Dernière intervention
27 mars 2018

Bonjour,

Le code que j´ai fait permet d´envoyer automatiquement un mail avec piece jointe au date 10 et 28 de chaque mois; vérifie si ce sont un samedi et un dimanche et décale l´envoie le lundi et vérifie si le fichier en piece jointe existe.

Option Explicit

Private Sub Application_Startup()
'Déclaration des variables
Dim ObjOutlook As Outlook.Application
Dim OBjMail As Outlook.MailItem
Dim NomFich As String
If Fecha = True Then
    NomFich = "C:\Users\user\....xlsx"
    If FichierExiste(NomFich) = False Then Exit Sub
    'Instance des Objets
         Set ObjOutlook = Outlook.Application
        Set OBjMail = ObjOutlook.CreateItem(olMailItem)
        
        With OBjMail
            .To = "...@gmail.com" ' le destinataire
            .Subject = "Test"
            .Body = "Buenos dias," & Chr(10) & Chr(10) & " Este es un correo automatico parte de " & Application.GetNamespace("MAPI").CurrentUser
            .Attachments.Add NomFich
            '.Display  '   Ici on peut supprimer pour l'envoyer sans vérification
            .Send
        End With
    'ObjOutlook.Quit 'ici si l´on veut quitter outlook
    Set OBjMail = Nothing
    Set ObjOutlook = Nothing
End If
End Sub

Private Function FichierExiste(MonFichier As String) As Boolean
   If Len(Dir(MonFichier)) > 0 Then
   FichierExiste = True
   Else
   FichierExiste = False
   End If
End Function

Private Function Fecha() As Boolean
Fecha = False
Dim fe As String, FechaHoy As Date, FechaM1 As Date, FechaM2 As Date
FechaHoy = Date
FechaM1 = DateSerial(Year(Date), Month(Date), 10)
    If Weekday(FechaM1) = 1 Then
    FechaM1 = DateAdd("d", 1, FechaM1)
    ElseIf Weekday(FechaM1) = 7 Then
    FechaM1 = DateAdd("d", 2, FechaM1)
    End If

FechaM2 = DateSerial(Year(Date), Month(Date), 28)
    If Weekday(FechaM2) = 1 Then
    FechaM2 = DateAdd("d", 1, FechaM2)
    ElseIf Weekday(FechaM2) = 7 Then
    FechaM2 = DateAdd("d", 2, FechaM2)
    End If

If Weekday(FechaM1) >= 2 And Weekday(FechaM1) <= 6 Then
    If FechaM1 = FechaHoy Then Fecha = True
End If
If Weekday(FechaM2) >= 2 And Weekday(FechaM2) <= 6 Then
    If FechaM2 = FechaHoy Then Fecha = True
End If
End Function