- '
- ' MadeIn@CEREAL
- ' Fonction d'envoi d'un mail avec Outlook 2003
- '
- ' Il faut avant d'utiliser ajouter la référence à Outlook dans les références COM
- ' Microsoft Office 11 Object Library
- ' Importer le Namespace
- ' Imports Outlook = Microsoft.Office.Interop.Outlook
- '
- ' Utilisation de la fonction :
- ' Function CreateMail(ByVal astrRecip As String, ByVal strSubject As String, ByVal strMessage As String, Optional ByVal astrAttachments As String = "") As Boolean
- '
- ' ByVal astrRecip As String
- ' Liste des destinataires séparés par des points virgules ;
- '
- ' ByVal strSubject As String
- ' Sujet du message
- '
- 'ByVal strMessage As String
- ' Corps du message
- '
- 'Optional ByVal astrAttachments As String
- ' Liste des fichiers attachés séparés par des points virgules ;
- '
- ' Exemple :
- ' CreateMail("dest1@test.com;dest2@test.int", "Sujet du message", "Corps du message à envoyer", "monfichier1.zip;monfichier2.doc")
- '
- ' Adaptation du code exemple http://www.vbfrance.com/codes/CONTROLER-OUTLOOK-ENVOYER-MAIL-DEPUIS-VB_320.aspx mais pour qu'il fonctionne avec du .NET
- '
- Imports Outlook = Microsoft.Office.Interop.Outlook
- Module SendOutlookMail
- Function CreateMail(ByVal astrRecip As String, ByVal strSubject As String, ByVal strMessage As String, Optional ByVal astrAttachments As String = "") As Boolean
-
- Dim olApp As Outlook.Application
- Dim objNewMail As Outlook.MailItem
- Dim varRecip As Object
- Dim varAttach As Object
- Dim blnResolveSuccess As Boolean
- Dim sRceipList() As String
- Dim sAttachments() As String
-
- olApp = New Outlook.Application
- objNewMail = olApp.CreateItem(Outlook.OlItemType.olMailItem)
-
- 'Crée un tableau avec la liste des expéditeurs
- sRceipList = Split(astrRecip, ";")
- sAttachments = Split(astrAttachments, ";")
- With objNewMail
- ' Add each item in the varRecip array to the Recipients collection.
- For Each varRecip In sRceipList
- .Recipients.Add(varRecip)
- Next varRecip
-
- ' Determine if all recipients have corresponding entries in the
- ' Outlook address book.
- blnResolveSuccess = .Recipients.ResolveAll
-
- ' Add each item in the varAttach array to the Attachments collection
- ' and specify the subject and text of the mail message.
- For Each varAttach In sAttachments
- .Attachments.Add(varAttach)
- Next varAttach
- .Subject = strSubject
- .Body = strMessage
-
- ' If all recipients are valid then send the message now, otherwise
- ' display the message so the user can fix invalid e-mail addresses.
- If blnResolveSuccess Then
- .Send()
- '
- '.Display()
- Else
- MsgBox("Unable to resolve all recipients. Please check " & "the names.")
- .Display()
- End If
- End With
-
- Return True
- End Function
-
-
- End Module
'
' MadeIn@CEREAL
' Fonction d'envoi d'un mail avec Outlook 2003
'
' Il faut avant d'utiliser ajouter la référence à Outlook dans les références COM
' Microsoft Office 11 Object Library
' Importer le Namespace
' Imports Outlook = Microsoft.Office.Interop.Outlook
'
' Utilisation de la fonction :
' Function CreateMail(ByVal astrRecip As String, ByVal strSubject As String, ByVal strMessage As String, Optional ByVal astrAttachments As String = "") As Boolean
'
' ByVal astrRecip As String
' Liste des destinataires séparés par des points virgules ;
'
' ByVal strSubject As String
' Sujet du message
'
'ByVal strMessage As String
' Corps du message
'
'Optional ByVal astrAttachments As String
' Liste des fichiers attachés séparés par des points virgules ;
'
' Exemple :
' CreateMail("dest1@test.com;dest2@test.int", "Sujet du message", "Corps du message à envoyer", "monfichier1.zip;monfichier2.doc")
'
' Adaptation du code exemple http://www.vbfrance.com/codes/CONTROLER-OUTLOOK-ENVOYER-MAIL-DEPUIS-VB_320.aspx mais pour qu'il fonctionne avec du .NET
'
Imports Outlook = Microsoft.Office.Interop.Outlook
Module SendOutlookMail
Function CreateMail(ByVal astrRecip As String, ByVal strSubject As String, ByVal strMessage As String, Optional ByVal astrAttachments As String = "") As Boolean
Dim olApp As Outlook.Application
Dim objNewMail As Outlook.MailItem
Dim varRecip As Object
Dim varAttach As Object
Dim blnResolveSuccess As Boolean
Dim sRceipList() As String
Dim sAttachments() As String
olApp = New Outlook.Application
objNewMail = olApp.CreateItem(Outlook.OlItemType.olMailItem)
'Crée un tableau avec la liste des expéditeurs
sRceipList = Split(astrRecip, ";")
sAttachments = Split(astrAttachments, ";")
With objNewMail
' Add each item in the varRecip array to the Recipients collection.
For Each varRecip In sRceipList
.Recipients.Add(varRecip)
Next varRecip
' Determine if all recipients have corresponding entries in the
' Outlook address book.
blnResolveSuccess = .Recipients.ResolveAll
' Add each item in the varAttach array to the Attachments collection
' and specify the subject and text of the mail message.
For Each varAttach In sAttachments
.Attachments.Add(varAttach)
Next varAttach
.Subject = strSubject
.Body = strMessage
' If all recipients are valid then send the message now, otherwise
' display the message so the user can fix invalid e-mail addresses.
If blnResolveSuccess Then
.Send()
'
'.Display()
Else
MsgBox("Unable to resolve all recipients. Please check " & "the names.")
.Display()
End If
End With
Return True
End Function
End Module