Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Outlook Comment envoyer un mail sur outlook avec Vba

Comment envoyer un mail sur outlook avec Vba

3 réponses
Avatar
sice
Bonjour,
je suis d=E9butant dans la programmation en VBA , cette proc=E9dure ci
dessous me permettent d'envoyer des mails =E0 plusieurs destinataires.
Je voudrais ins=E9rer une bo=EEte de dialogue du style : 1 - voulez-vous
envoyer le mail tel quel, 2 - voulez-vous ajouter un commentaire, 3 -
ne rien envoyer.
Votre aide serait la bienvenue ! merci d'avance.
La proc=E9dure :

Sub Mail_Selection_Outlook_Body2()
' You must add a reference to the Microsoft outlook Library
' Don't forget to copy the function RangetoHTML2 in the module.
' Is not working in Office 97
Dim source As Range
Dim dest As Workbook
'Dim OutApp As Outlook.Application
'Dim OutMail As Outlook.MailItem

Set source =3D Nothing
On Error Resume Next
Set source =3D Selection.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If source Is Nothing Then
MsgBox "The selection is not a range or the sheet is protect" &
_
vbNewLine & "please correct and try again.", vbOKOnly
Exit Sub
End If

If ActiveWindow.SelectedSheets.Count > 1 Or _
Selection.Cells.Count =3D 1 Or _
Selection.Areas.Count > 1 Then
MsgBox "An Error occurred :" & vbNewLine & vbNewLine & _
"You have more than one sheet selected." & vbNewLine & _
"You only selected one cell." & vbNewLine & _
"You selected more than one area." & vbNewLine &
vbNewLine & _
"Please correct and try again.", vbOKOnly
Exit Sub
End If

Application.ScreenUpdating =3D False
source.Copy
Set dest =3D Workbooks.Add(xlWBATWorksheet)
With dest.Sheets(1)
.Cells(1).PasteSpecial Paste:=3D8
' Paste:=3D8 will copy the column width in Excel 2000 and higher
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
Application.CutCopyMode =3D False
End With

Set OutApp =3D CreateObject("Outlook.Application")
Set OutMail =3D OutApp.CreateItem(olMailItem)
With OutMail
.To =3D "ddd@fec.com; eee@mlo.com; rrr@zae.com"
.CC =3D "aaaa@vba.com; bbb@mail.com; ssss@lundi.com"
.BCC =3D ""
.Subject =3D "HORUS Deal SG MAD"
.HTMLBody =3D RangetoHTML2
.Send 'or use .Display
End With

dest.Close False
Set OutMail =3D Nothing
Set OutApp =3D Nothing
Set dest =3D Nothing
Application.ScreenUpdating =3D True
End Sub


Public Function RangetoHTML2()
' You can't use this function in Excel 97
Dim fso As Object
Dim ts As Object
Dim TempFile As String
TempFile =3D Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss")
& ".htm"
With ActiveWorkbook.PublishObjects.Add( _
SourceType:=3DxlSourceRange, _
Filename:=3DTempFile, _
Sheet:=3DActiveSheet.Name, _
source:=3DActiveSheet.UsedRange.Address, _
HtmlType:=3DxlHtmlStatic)
.Publish (True)
End With
Set fso =3D CreateObject("Scripting.FileSystemObject")
Set ts =3D fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML2 =3D ts.ReadAll
ts.Close
Set ts =3D Nothing
Set fso =3D Nothing
Kill TempFile
End Function
Signaler un problème avec ce contenu

3 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
Oliv'
*sice que je salut a écrit *:
Bonjour,
je suis débutant dans la programmation en VBA , cette procédure ci
dessous me permettent d'envoyer des mails à plusieurs destinataires.
Je voudrais insérer une boîte de dialogue du style : 1 - voulez-vous
envoyer le mail tel quel, 2 - voulez-vous ajouter un commentaire, 3 -
ne rien envoyer.


Tu mets à la place du ".Send "

envoyer = MsgBox("Envoyer avec un commentaire ?", vbYesNoCancel)

If envoyer = vbYes Then
.display
ElseIf envoyer = vbNo Then
.send
Else
Exit Sub
End If


--
--
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Have a nice day
Oliv'
Pour me joindre : http://cerbermail.com/?V8r2o1YHl4
les sites références:
Excel :http://www.excelabo.net http://xcell05.free.fr/
http://dj.joss.free.fr/
http://frederic.sigonneau.free.fr/ http://www.excel-vba-francais.com/
Word : http://faqword.free.fr/
Outlook : http://faq.outlook.free.fr/
les archives : http://groups.google.com/group/microsoft.public.fr.outlook
OE6 : http://www.faqoe.com/
Sql : http://sqlpro.developpez.com/
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Votre aide serait la bienvenue ! merci d'avance.
La procédure :

Sub Mail_Selection_Outlook_Body2()
' You must add a reference to the Microsoft outlook Library
' Don't forget to copy the function RangetoHTML2 in the module.
' Is not working in Office 97
Dim source As Range
Dim dest As Workbook
'Dim OutApp As Outlook.Application
'Dim OutMail As Outlook.MailItem

Set source = Nothing
On Error Resume Next
Set source = Selection.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If source Is Nothing Then
MsgBox "The selection is not a range or the sheet is protect"
& _
vbNewLine & "please correct and try again.", vbOKOnly
Exit Sub
End If

If ActiveWindow.SelectedSheets.Count > 1 Or _
Selection.Cells.Count = 1 Or _
Selection.Areas.Count > 1 Then
MsgBox "An Error occurred :" & vbNewLine & vbNewLine & _
"You have more than one sheet selected." & vbNewLine &
_ "You only selected one cell." & vbNewLine & _
"You selected more than one area." & vbNewLine &
vbNewLine & _
"Please correct and try again.", vbOKOnly
Exit Sub
End If

Application.ScreenUpdating = False
source.Copy
Set dest = Workbooks.Add(xlWBATWorksheet)
With dest.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
' Paste:=8 will copy the column width in Excel 2000 and higher
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
Application.CutCopyMode = False
End With

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail
.To = "; ; "
.CC = "; ; "
.BCC = ""
.Subject = "HORUS Deal SG MAD"
.HTMLBody = RangetoHTML2
.Send 'or use .Display
End With

dest.Close False
Set OutMail = Nothing
Set OutApp = Nothing
Set dest = Nothing
Application.ScreenUpdating = True
End Sub


Public Function RangetoHTML2()
' You can't use this function in Excel 97
Dim fso As Object
Dim ts As Object
Dim TempFile As String
TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy
h-mm-ss") & ".htm"
With ActiveWorkbook.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=TempFile, _
Sheet:¬tiveSheet.Name, _
source:¬tiveSheet.UsedRange.Address, _
HtmlType:=xlHtmlStatic)
.Publish (True)
End With
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML2 = ts.ReadAll
ts.Close
Set ts = Nothing
Set fso = Nothing
Kill TempFile
End Function


Avatar
sice
Bonjour,

Je voudrais envoyer des FAX automatiquement (toujours avec vba ), pour
cela j'ai acheté un Kit companion qui permet de relier le PC au FAX
pour pouvoir les envoyer.Avez vous des connaisances dans ce domaine?
ps: le fax est de marque SAGEM (MF3560) et le poste à partir duquel le
fax sera envoyé est un poste ARPEGE qui utilise Excel power plus de
Reuters on travaille avec office 2003 et outlook 2003.
Le kit companion fait le lien entre le PC et le fax , (il nous a été
remis un CD et un cable de type USB lors de son achat !)
cdt,
sice42

*sice que je salut a écrit *:
Bonjour,
je suis débutant dans la programmation en VBA , cette procédure ci
dessous me permettent d'envoyer des mails à plusieurs destinataires.
Je voudrais insérer une boîte de dialogue du style : 1 - voulez-vous
envoyer le mail tel quel, 2 - voulez-vous ajouter un commentaire, 3 -
ne rien envoyer.


Tu mets à la place du ".Send "

envoyer = MsgBox("Envoyer avec un commentaire ?", vbYesNoCancel)

If envoyer = vbYes Then
.display
ElseIf envoyer = vbNo Then
.send
Else
Exit Sub
End If


--
--
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Have a nice day
Oliv'
Pour me joindre : http://cerbermail.com/?V8r2o1YHl4
les sites références:
Excel :http://www.excelabo.net http://xcell05.free.fr/
http://dj.joss.free.fr/
http://frederic.sigonneau.free.fr/ http://www.excel-vba-francais.com/
Word : http://faqword.free.fr/
Outlook : http://faq.outlook.free.fr/
les archives : http://groups.google.com/group/microsoft.public.fr.outlook
OE6 : http://www.faqoe.com/
Sql : http://sqlpro.developpez.com/
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Votre aide serait la bienvenue ! merci d'avance.
La procédure :

Sub Mail_Selection_Outlook_Body2()
' You must add a reference to the Microsoft outlook Library
' Don't forget to copy the function RangetoHTML2 in the module.
' Is not working in Office 97
Dim source As Range
Dim dest As Workbook
'Dim OutApp As Outlook.Application
'Dim OutMail As Outlook.MailItem

Set source = Nothing
On Error Resume Next
Set source = Selection.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If source Is Nothing Then
MsgBox "The selection is not a range or the sheet is protect"
& _
vbNewLine & "please correct and try again.", vbOKOnly
Exit Sub
End If

If ActiveWindow.SelectedSheets.Count > 1 Or _
Selection.Cells.Count = 1 Or _
Selection.Areas.Count > 1 Then
MsgBox "An Error occurred :" & vbNewLine & vbNewLine & _
"You have more than one sheet selected." & vbNewLine &
_ "You only selected one cell." & vbNewLine & _
"You selected more than one area." & vbNewLine &
vbNewLine & _
"Please correct and try again.", vbOKOnly
Exit Sub
End If

Application.ScreenUpdating = False
source.Copy
Set dest = Workbooks.Add(xlWBATWorksheet)
With dest.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
' Paste:=8 will copy the column width in Excel 2000 and higher
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
Application.CutCopyMode = False
End With

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail
.To = "; ; "
.CC = "; ; "
.BCC = ""
.Subject = "HORUS Deal SG MAD"
.HTMLBody = RangetoHTML2
.Send 'or use .Display
End With

dest.Close False
Set OutMail = Nothing
Set OutApp = Nothing
Set dest = Nothing
Application.ScreenUpdating = True
End Sub


Public Function RangetoHTML2()
' You can't use this function in Excel 97
Dim fso As Object
Dim ts As Object
Dim TempFile As String
TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy
h-mm-ss") & ".htm"
With ActiveWorkbook.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=TempFile, _
Sheet:¬tiveSheet.Name, _
source:¬tiveSheet.UsedRange.Address, _
HtmlType:=xlHtmlStatic)
.Publish (True)
End With
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML2 = ts.ReadAll
ts.Close
Set ts = Nothing
Set fso = Nothing
Kill TempFile
End Function




Avatar
Oliv'
J'aurais besoin encore d'un peu d'explication,

*sice que je salut a écrit *:
Bonjour,

Je voudrais envoyer des FAX automatiquement (toujours avec vba ), pour
cela j'ai acheté un Kit companion qui permet de relier le PC au FAX
pour pouvoir les envoyer.Avez vous des connaisances dans ce domaine?
ps: le fax est de marque SAGEM (MF3560) et le poste à partir duquel le
fax sera envoyé est un poste ARPEGE qui utilise Excel power plus de
Reuters
power plus est donc un addin pour EXCEL en relation avec un logiciel

financier REUTERS c'est bien cela ?
C'est quoi un poste ARPEGE ,une marque de PC , un terminal server ?

on travaille avec office 2003 et outlook 2003.
Le kit companion fait le lien entre le PC et le fax , (il nous a été
remis un CD et un cable de type USB lors de son achat !)


ton kit companion c'est donc un logiciel !
Comment cela se passe t'il quand tu envoi un fax c'est comme si tu imprimais
avec en plus un module qui te demande les informations de destination ?

Donc si c'est comme une imprimante la première partie n'est pas compliquée,
sous excel donc :

oldprinter = ActivePrinter
Msgbox oldprinter
'il faut mettre le nom tel que défini dans le panneau de config avec le LPT
'si tu sais pas choisi comme imprimante le SAGEM avant de lancer ce bout de
code et la ligne msgbox ci dessus te donnera le nom
ActivePrinter = "MF3560 sur LPT1:"
Application.Sheets("nom de ta feuille").PrintOut 'ou ActiveSheet.PrintOut
' il y a des options possibles pour printout selectionne ce mot dans vbe +
f1 pour l'aide.
'remise en place des options
ActivePrinter = oldprinter

Par contre tu devras répondres à la boite de dialogue de ton logiciel fax
manuellement je pense et cela ne pourra pas se programmer sauf peut être
avec la l'instruction SendKeys (voir l'aide) ou si ton logiciel fax a une
bibliotheque ACTIVEX ou OLE !!!

quand tu postes une question mets toi à la place de quelqu'un qui ne connais
pas avec quoi tu travailles. ;-)))
Olivier

cdt,
sice42

*sice que je salut a écrit *:
Bonjour,
je suis débutant dans la programmation en VBA , cette procédure ci
dessous me permettent d'envoyer des mails à plusieurs destinataires.
Je voudrais insérer une boîte de dialogue du style : 1 - voulez-vous
envoyer le mail tel quel, 2 - voulez-vous ajouter un commentaire, 3
- ne rien envoyer.


Tu mets à la place du ".Send "

envoyer = MsgBox("Envoyer avec un commentaire ?", vbYesNoCancel)

If envoyer = vbYes Then
.display
ElseIf envoyer = vbNo Then
.send
Else
Exit Sub
End If


--
--
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Have a nice day
Oliv'
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Votre aide serait la bienvenue ! merci d'avance.
La procédure :

Sub Mail_Selection_Outlook_Body2()
' You must add a reference to the Microsoft outlook Library
' Don't forget to copy the function RangetoHTML2 in the module.
' Is not working in Office 97
Dim source As Range
Dim dest As Workbook
'Dim OutApp As Outlook.Application
'Dim OutMail As Outlook.MailItem

Set source = Nothing
On Error Resume Next
Set source = Selection.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If source Is Nothing Then
MsgBox "The selection is not a range or the sheet is
protect" & _
vbNewLine & "please correct and try again.", vbOKOnly
Exit Sub
End If

If ActiveWindow.SelectedSheets.Count > 1 Or _
Selection.Cells.Count = 1 Or _
Selection.Areas.Count > 1 Then
MsgBox "An Error occurred :" & vbNewLine & vbNewLine & _
"You have more than one sheet selected." & vbNewLine
& _ "You only selected one cell." & vbNewLine & _
"You selected more than one area." & vbNewLine &
vbNewLine & _
"Please correct and try again.", vbOKOnly
Exit Sub
End If

Application.ScreenUpdating = False
source.Copy
Set dest = Workbooks.Add(xlWBATWorksheet)
With dest.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
' Paste:=8 will copy the column width in Excel 2000 and
higher .Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
Application.CutCopyMode = False
End With

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail
.To = "; ; "
.CC = "; ; "
.BCC = ""
.Subject = "HORUS Deal SG MAD"
.HTMLBody = RangetoHTML2
.Send 'or use .Display
End With

dest.Close False
Set OutMail = Nothing
Set OutApp = Nothing
Set dest = Nothing
Application.ScreenUpdating = True
End Sub


Public Function RangetoHTML2()
' You can't use this function in Excel 97
Dim fso As Object
Dim ts As Object
Dim TempFile As String
TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy
h-mm-ss") & ".htm"
With ActiveWorkbook.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=TempFile, _
Sheet:¬tiveSheet.Name, _
source:¬tiveSheet.UsedRange.Address, _
HtmlType:=xlHtmlStatic)
.Publish (True)
End With
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML2 = ts.ReadAll
ts.Close
Set ts = Nothing
Set fso = Nothing
Kill TempFile
End Function