Envoi email automatique code VBA Outlook

lgvba

XLDnaute Nouveau
sALU a tous

je souhaiterais ameliorer le code vba ci dessous afin d ' eviter le message d ' alerte 'autorisation d ' excel avant d effectuer l ' envoie automatique d ' email via outlook lors de l execution de ma macro.

Aussi serait t ' il possible de rajouter dans le corp de mon courriel le message " Salu." .

je vous remercie d ' avance pour votre aide

LGVBA


Dim Destinataire As String, Sujet As String
'Dim AccuseReception As Boolean
Destinataire = Adresse_courriel
Sujet = "Décompte personnel"
ThisWorkbook.Sheets("Base courriel").Copy
ActiveWorkbook.SendMail Destinataire, Sujet
ActiveWorkbook.Close False



Mon code vba en entier


Sub aaa()

Dim Début As Integer, Fin As Integer, Grand_total As Currency, ID_traité As String, Nom_traité As String
Dim feuillenom As String, i As Integer, Adresse_courriel As String

Application.ScreenUpdating = False

feuillenom = Date '& " - " & Hour(Time) & "h " & Minute(Time) & "m"

Sheets("Base").Copy After:=Sheets(1)
'Sheets("Base2").Name = feuillenom
Columns("F:F").NumberFormat = "#,##0.00"
ActiveSheet.Shapes("Button 1").Delete

Range("A2").Activate

Retour:
ID_traité = ActiveCell
Nom_traité = ActiveCell.Offset(0, 1)

With Sheets("Adresses électroniques")
For i = 2 To .Range("A65000").End(xlUp).Row
If .Cells(i, 1) = ID_traité And .Cells(i, 2) = Nom_traité Then Adresse_courriel = .Cells(i, 3)
Next i
End With

Début = ActiveCell.Row
Do Until ActiveCell <> ID_traité Or ActiveCell.Offset(0, 1) <> Nom_traité
ActiveCell.Offset(1, 0).Activate
Loop
Fin = ActiveCell.Row - 1

Rows(Fin + 1 & ":" & Fin + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

Cells(ActiveCell.Row, 5) = "Total"
Cells(ActiveCell.Row, 6) = WorksheetFunction.Sum(Range(Cells(Début, 6), Cells(Fin, 6)))
Grand_total = Grand_total + Cells(ActiveCell.Row, 6)
Range(Cells(ActiveCell.Row, 5), Cells(ActiveCell.Row, 6)).Font.Bold = True
With Range(Cells(ActiveCell.Row, 5), Cells(ActiveCell.Row, 6)).Interior
.Color = 5296274
End With
With Range(Cells(ActiveCell.Row, 5), Cells(ActiveCell.Row, 6))
.BorderAround Weight:=xlMedium
End With
With Range(Cells(ActiveCell.Row + 1, 1), Cells(ActiveCell.Row + 1, 6)).Interior
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.349986266670736
End With
Range(Cells(Début, 1), Cells(Fin, 6)).Borders.Weight = xlThin

'Report individuel sur feuille "Base courriel"
With Sheets("Base courriel")
.Range("A2:F65000").Delete
Range(Cells(Début, 1), Cells(Fin + 1, 6)).Copy Destination:=.Range("A2")
End With



Dim Destinataire As String, Sujet As String
Dim AccuseReception As Boolean
Destinataire = Adresse_courriel
Sujet = "Détail Prélevement Bancaire"
ThisWorkbook.Sheets("Base courriel").Copy
ActiveWorkbook.SendMail Destinataire, Sujet
ActiveWorkbook.Close False


ActiveCell.Offset(2, 0).Activate
If ActiveCell = "" Then
Cells(Fin + 3, 5) = "Grand Total"
Cells(Fin + 3, 6) = Grand_total
Range(Cells(Fin + 3, 5), Cells(Fin + 3, 6)).Font.Bold = True
With Range(Cells(Fin + 3, 5), Cells(Fin + 3, 6)).Interior
.Color = 5296274
End With
With Range(Cells(Fin + 3, 5), Cells(Fin + 3, 6))
.BorderAround Weight:=xlMedium
End With

Exit Sub
End If

GoTo Retour

End Sub
 

Statistiques des forums

Discussions
312 946
Messages
2 093 827
Membres
105 848
dernier inscrit
toooom