1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72
| Option Explicit
Dim ol As New Outlook.Application
Dim olmail As MailItem
Dim CurrFile As String
Dim MailDestinataire As String
Dim MailObjet As String
Dim MailCorps As String
Dim LingesCorps As Integer
Dim appExcel As Excel.Application
Dim ExcelWorkooks As Excel.Workbooks
Dim ExcelWorkbook As Excel.Workbook
Dim sheet As Excel.Worksheet
Public Function SendMail_Outlook()
Set appExcel = functOpenExcelFile(BoutonAction.ExcelFullFileName)
LingesCorps = 12
MailDestinataire = appExcel.Sheets(1).Cells(2, 7).Value
MailObjet = Application.Sheets(1).Cells(9, 2).Value
'Avant de lancer cette macro, Dans l'éditeur VBA: Faire Menu / Tools / Reference / Cocher "Microsoft Outlook Library"
Set ol = New Outlook.Application
Set olmail = ol.CreateItem(olMailItem)
With olmail
.To = MailDestinataire
.Subject = MailObjet
End With
With olmail
While LingesCorps < 37
MailCorps = Application.Sheets(1).Cells(LingesCorps, 2).Value
.Body = MailCorps & Range("c1").Value & Range("d1").Value & Range("e1").Value
LingesCorps = LingesCorps + 1
Wend
End With
With olmail
' .Attachments.Add "c:\data\essai.doc"
.Display '.Send
'On peut switcher entre .send et .display selon que l'on veut envoyer le mail (send) ou seulement le préparer et le vérifier(display)
End With
appExcel.Workbooks.Close
End Function
' Sub Quit_Outlook()
' 'Demander à Excel de Quitter Outlook
' Set myOlApp = CreateObject("Outlook.Application")
' myOlApp.Quit
' End Sub
'
'
' Geler la Mise à jour de l'écran pour accélerer le Code VBA
' Application.ScreenUpdating = False
' 'Gèle l'affichage à l'écran: cela accélère le déroulement de la macro.
' Application.ScreenUpdating = True
' 'Gèle l'affichage à l'écran: cela accélère le déroulement de la macro.
'
'
' Télécharger un Fichier illustrant le fonctionnement de cette macro (et d'autres macros):
' Sub Zone_Maj()
' 'Transforme les cellules de la zone sélectionnée en Majuscules
' Sub
' For Each Cell In Selection
' Cell.Value = UCase(Cell.Value)
' Next Cell
' End Sub |
Partager