Envoi automatique mail

Bonjour

J'ai un programme me permettant d'ouvrir automatiquement un fichier txt, filtrer ses infos, sauvegarder ses infos dans un autre classeur et je voudrais ensuite pouvoir automatiquement envoyer ce classeur par mail OUTLOOK

J'ai trouvé sur internet quelques trucs mais je n'arrive pas à le coordonner avec mon code :

Sub SendMail_Outlook()

'Avant de lancer cette macro, Dans l'éditeur VBA: Faire Menu / Tools / Reference / Cocher "Microsoft Outlook Library"
'Il est possible de vérifier avant l'exécution de la macro si la référence est activée ou non, et de l'activer si ce n'est pas le cas

Dim Ol As New Outlook.Application
Dim Olmail As MailItem
Dim CurrFile As String

    Set Ol = New Outlook.Application
    Set Olmail = Ol.CreateItem(olMailItem)
    With Olmail
        .To = "XXX.com"
        .Subject = "TestEnvoi"
        .Body = "Bliblibli"
        .Attachments.Add "C:\Users\fcharav\Documents\XXX\DataXXX.xlsm"
        .Display
        .Send = "XXX.com"

    End With
End Sub

ce programme est ensuite appellé dans ma macro faisant tout le reste

' La macro suivante permet d'importer le fichier text le plus récent depuis un répertoire

Sub ouvrir_fichier_recent()
Application.DisplayAlerts = False
'Déclaration des variables
Dim MyPath As String
Dim MyFile As String
Dim LatestFile As String
Dim LatestDate As Date
Dim LMD As Date
Dim SourceBook As Workbook, Desbook As Workbook
Dim destcell As Range

'Je définie le classeur de destination étant le classeur actif et la cellule de destination

Set DestBook = ActiveWorkbook

Set destcell = Worksheets(1).Range("A1")

MyPath = "C:\Users\fcharav\Documents\XXX" '*********REPERTOIRE D'IMPORTATION DE LA BASE DE DONNEES TEXT, A MODIFIER EN FONCTION DU BESOIN **********

'S'assurer que le chemin se termine par un antislash
If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"

'Extraction du premier fichier texte du dossier
MyFile = Dir(MyPath & "*.txt", vbNormal)

'Si aucun fichier n'est trouvé, quitter le sub
If Len(MyFile) = 0 Then
MsgBox "Aucun fichier trouvé...", vbExclamation
Exit Sub
End If

'Boucle sur tous les fichiers text dans le dossier
Do While Len(MyFile) > 0

'Attribution d'une variable à la date du fichier actuel

LMD = FileDateTime(MyPath & MyFile)

If LMD > LatestDate Then
LatestFile = MyFile
LatestDate = LMD
End If

'Prendre le prochain fichier text dans le dossier
MyFile = Dir

Loop

'Ouvrier le fichier le plus récent
Workbooks.OpenText MyPath & LatestFile, Origin:= _
        xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote _
        , ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=True, Comma:=False _
        , Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1)), TrailingMinusNumbers:=True

        'Array(10,2) me permet de garder la colonne J en format text de manière à garder l'intégralité du numéro d'identification du main hub.

' Je copie les données depuis le fichier source que je ferme ensuite

   Set SourceBook = ActiveWorkbook
   Range(Range("A1"), Range("A1").SpecialCells(xlLastCell)).Copy

'Je colle les données pages 1 de mon fichier d'execution
   ThisWorkbook.Activate
   destcell.PasteSpecial Paste:=xlValues
   SourceBook.Close False

    Call CopieData
    Call SauvegardeFichier
    Call SendMail_Outlook
    'Application.DisplayAlerts = False
    'ActiveWorkbook.Close
    'Application.DisplayAlerts = True

End Sub

L'erreur indiqué quand je compile est : Expected Function or variable , au niveau de ma ligne "Sub SendMail_Outlook()

si quelqu'un sait d'ou vient le probleme

Je ne peux pas vous envoyer mon fichier il est trop gros :/

Hello,

J'ai juste fait tourner la macro outlook elle a une erreur.

Code avec commentaire ou il y à une erreur.

Sub SendMail_Outlook()

'Avant de lancer cette macro, Dans l'éditeur VBA: Faire Menu / Tools / Reference / Cocher "Microsoft Outlook Library"
'Il est possible de vérifier avant l'exécution de la macro si la référence est activée ou non, et de l'activer si ce n'est pas le cas

Dim Ol As New Outlook.Application
Dim Olmail As MailItem
Dim CurrFile As String

    Set Ol = New Outlook.Application
    Set Olmail = Ol.CreateItem(olMailItem)
    With Olmail
        .To = "XXX.com"
        .Subject = "TestEnvoi"
        .Body = "Bliblibli"
        .Attachments.Add "C:\Users\fcharav\Documents\XXX\DataXXX.xlsm"
        .Display 'soit display soit send
        .Send = "XXX.com" 'pas de = aprés send

    End With
End Sub

Ce code fonctionne chez moi essaye avec celui la.

Sub SendMail_Outlook()

'Avant de lancer cette macro, Dans l'éditeur VBA: Faire Menu / Tools / Reference / Cocher "Microsoft Outlook Library"
'Il est possible de vérifier avant l'exécution de la macro si la référence est activée ou non, et de l'activer si ce n'est pas le cas

Dim Ol As New Outlook.Application
Dim Olmail As MailItem
Dim CurrFile As String

    Set Ol = New Outlook.Application
    Set Olmail = Ol.CreateItem(olMailItem)
    With Olmail
        .To = "XXX.com"
        .Subject = "TestEnvoi"
        .Body = "Bliblibli"
        .Attachments.Add "C:\Users\fcharav\Documents\XXX\DataXXX.xlsm"
        .Display

    End With
End Sub

Ouais je m'etais trompé et problème régler :p

Tout marche bien

Un exemple ci-dessous d'un exemple qui fonctionne chez moi:

Du texte écrit dans un fichier excel. Sur ce même onglet les adresses mails à qui envoyer (une centaine pour mon cas).

Un petit bouton envoyer mail et outlook s'ouvre avec l'ensemble des adresses mail ainsi que le texte dans le corps du mail.

Bon courage

Private Sub CommandButton1_Click()

Dim olApp As Outlook.Application

Dim olMail As MailItem

Dim CurrFile As String

Set olApp = New Outlook.Application

For i = 6 To 100

If Cells(i, 2) <> "" Then

Set olMail = olApp.CreateItem(olMailItem)

With olMail

.To = Cells(i, 2)

.CC = Range("E3")

.Subject = Range("C3")

.Attachments.Add ("EMPLACEMENT DE TON FICHIER SUR TON DISQUE DUR")

.Body = Range("A5") & vbCrLf & Range("A6") & vbCrLf & Range("A7") & vbCrLf & Range("A8") & vbCrLf & Range("A9") & vbCrLf & Range("A10") & vbCrLf & Range("A11") & vbCrLf & Range("A12") & vbCrLf & Range("A13") & vbCrLf & Range("A14") & vbCrLf & Range("A15") & " " & Cells(i, 1) & vbCrLf & vbCrLf & Range("A19") & vbCrLf & Range("A20") & vbCrLf & Range("A21") & vbCrLf & Range("A22") & vbCrLf & Range("A23") & vbCrLf & Range("A24") & vbCrLf & Range("A25") & vbCrLf & Range("A26") & vbCrLf & Range("A27") & vbCrLf & Range("A28")

'.Display ' pour afficher le message dans outlook enlever le '

.Send ' envoyer le message

Set olMail = Nothing

End With

End If

Next i

Set olApp = Nothing

End Sub