Les mémos

Fermer Tables

Fermer Requêtes

Fermer Formulaires

Fermer Etats

Fermer Modules

Fermer Base

Fermer Automation

Fermer Administration

Fermer Registre

Fermer String

Fermer Email CDO

Fermer Outlook

Fermer Net

Fermer Dates - Heures

Fermer Fichiers

Fermer Références

Fermer Vrac

Je débute...

Fermer La normalisation

Fermer VBA

Attention
Aucun support
par émail !

Utilisez le forum pour les questions/réponses concernant MsAccess et les codes que vous trouverez sur ce site.
Visites

   visiteurs

   visiteurs en ligne

Outlook - Integrer un état

Intégrer un état Access dans le corps d'un message électronique

 


Il suffit pour cela de placer un bouton sur un formulaire et dans la Sub de l'événement "Sur clic" de placer l'appel au code fourni ci-dessous.

Exemple de code pour le bouton:

Code :
SendReportHTML "Nom état", "toto@hotmail.com", "Objet", False

Au lieu de False comme dernier paramètre, on peut utiliser True ce qui permet d'éditer le message avant l'envoi.

Attention : Il faut utiliser le second code pour Access 2007 et plus


Code pour Access 2000 à 2003

Code :
Public Sub SendReportHTML(NomEtat As String, _
Destinataire As String, _
Sujet As String, _
EditMessage As Boolean, _
Optional PieceJointe As String)
'/ Déclaration des variables
Dim NbFichiers As Integer
Dim i As Integer
Dim LeFichier As String
Dim txtLine As String
Dim F As Integer
Dim CorpsHTML As String
Dim Ol_App As New Outlook.Application
Dim Ol_Item As Outlook.MailItem
'
DoCmd.Hourglass True
'
With Application.FileSearch
.LookIn = CurDir
.SearchSubFolders = False
.FileName = NomEtat & "*.htm"
.Execute
NbFichiers = .FoundFiles.Count
LeFichier = CurDir & "\" & NomEtat & ".htm"
DoCmd.OutputTo acOutputReport, NomEtat, acFormatHTML, LeFichier, False
.Execute
NbFichiers = .FoundFiles.Count - NbFichiers
End With
'
F = FreeFile
'
For i = 1 To NbFichiers
If i > 1 Then: LeFichier = CurDir & "" & NomEtat & "Page" & i & ".htm"
SysCmd acSysCmdInitMeter, "Intégration de " & LeFichier, NbFichiers
SysCmd acSysCmdUpdateMeter, i
Open LeFichier For Input As #F
Do While Not EOF(F)
Line Input #F, txtLine
CorpsHTML = CorpsHTML & txtLine
Loop
Close #F
Kill LeFichier
Next i
'
SysCmd acSysCmdClearStatus
Set Ol_Item = Ol_App.CreateItem(olMailItem)
'/ Création du message
With Ol_Item
.To = Destinataire
.Subject = Sujet
.HTMLBody = CorpsHTML
If PieceJointe <> "" Then: .Attachments.add PieceJointe
.Save
If EditMessage = True Then
.Display
Else
.Send
End If
End With
'/ Libération
Set Ol_Item = Nothing
Set Ol_App = Nothing
DoCmd.Hourglass False
End Sub



Code pour Access 2007 et plus

Code :
Public Sub SendReportHTML(NomEtat As String, _
Destinataire As String, _
Sujet As String, _
EditMessage As Boolean, _
Optional PieceJointe As String)
'/ Déclaration des variables
Dim NbFichiers As Integer
Dim i As Integer
Dim LeFichier As String
Dim txtLine As String
Dim F As Integer
Dim CorpsHTML As String
'/ Nécessite le référence Microsoft Outlook
Dim Ol_App As New Outlook.Application
Dim Ol_Nspace As Outlook.NameSpace
Dim Ol_Item As Outlook.MailItem
'
'/ Nécessite la référence Microsoft Scripting Runtime
Dim FSO As Scripting.FileSystemObject
Dim scrFolder As Scripting.Folder
Dim fileItem As Scripting.File
'
Set FSO = New Scripting.FileSystemObject
Set scrFolder = FSO.GetFolder(CurDir)
Set Ol_Nspace = Ol_App.GetNamespace("MAPI")
'
DoCmd.Hourglass True
'
With scrFolder.Files
NbFichiers = .Count
LeFichier = CurDir & "\" & NomEtat & ".htm"
'/ Export de l'état au format HTML
DoCmd.OutputTo acOutputReport, _
NomEtat, acFormatHTML, _
LeFichier, False
NbFichiers = (.Count - NbFichiers)
End With
'
F = FreeFile
'
For i = 1 To NbFichiers
If i > 1 Then
LeFichier = CurDir & "\" & NomEtat _
& "Page" & i & ".htm"
End If
'/ Affichage la progression dans la barre d'état
SysCmd acSysCmdInitMeter, "Intégration de " _
& LeFichier, NbFichiers
SysCmd acSysCmdUpdateMeter, i
'/ Lire le contenu des fichiers HTML
Open LeFichier For Input As #F
Do While Not EOF(F)
Line Input #F, txtLine
CorpsHTML = CorpsHTML & txtLine
Loop
Close #F
Kill LeFichier
Next i
'
SysCmd acSysCmdClearStatus
Set Ol_Item = Ol_App.CreateItem(olMailItem)
'/ Si Outlook non démarré
If Not Ol_Nspace Is Nothing Then
Ol_Nspace.Logon , , True, False
End If
'/ Construction du message
With Ol_Item
.To = Destinataire
.Subject = Sujet
.HTMLBody = CorpsHTML
If PieceJointe <> "" Then
.Attachments.Add PieceJointe
End If
.Save
If EditMessage = True Then
.Display
Else
.Send
End If
End With
'/ Libération
Ol_Nspace.Logoff
Set Ol_Item = Nothing
Set Ol_App = Nothing
Set FSO = Nothing
Set scrFolder = Nothing
DoCmd.Hourglass False
End Sub

Date de création : 01/11/2005 : 04:41
Dernière modification : 01/07/2010 : 02:39
Catégorie : Outlook
Page lue 7158 fois


Imprimer l'article Imprimer l'article

Recherche



Lettre d'information
Pour avoir des nouvelles de ce site, inscrivez-vous à notre Newsletter.
Captcha
Recopier le code :
Au sujet de l'auteur
L'auteur qui fréquente (fréquentait) le forum microsoft.public.fr.access a eu le plaisir d'être nommé MVP Office-Access de janvier 2003 à décembre 2011.

Qui sont les MVP ?

Divers ;-)
Nous contacter

Haut