Envoi mail depuis Access avec tableau Excel dans le corps du mail

Version imprimable

Bonjour,

Actuellement je gère l'analyse de données (Access), la constitution d'une analyse (Xlsx) et l'envoi de mail automatique (outlook) depuis Access.
Le mail envoyé contient en PJ un fichier xlsx regroupant l'analyse des données (Nbre de donnée, Nbre d'erreur, détail des erreurs, etc).

Dans ce mail, je souhaiterai insérer un tableau (Récap) contenu dans le fichier xlsx en PJ.
Dans le fichier xlsx le tableau est dans l'onglet "Récap" cellule "A1:E7".

J'ai essayé d'adapter plusieurs code mais sans résultat.
Merci de votre aide.

le code d'envoi mail :
Code:

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 '******************** '* envoi mail * '******************** Msgb = MsgBox("Voulez-vous envoyer le mail automatique ?", vbYesNo + vbQuestion, "Envoi Mail Automatique") If Msgb = vbNo Then Exit Sub Else Dim appOutlook Dim NewMail Dim text Dim FileAttach Dim MailSubject Dim Previousday Previousday = Day(Date) & "-" & Month(Date) & "-" & Year(Date) text = "Bonjour," & vbCrLf & vbCrLf & "Veuillez trouver ci-joint l'analyse en date du " & (Previousday) & "." & vbCrLf & "Le fichier d'analyse est disponible dans l'emplacement suivant : xxx " & vbCrLf & "Heure extraction : 11h" & vbCrLf & "Tableau Xls" & vbCrLf & vbCrLf & "Cordialement," & vbCrLf & "Equipe AMOA" FileAttach = "Chemin + Analyse " & Previousday & ".xlsx" MailSubject = "Analyse au " & (Previousday) 'Generating and sending an e-mail: Set appOutlook = CreateObject("OUTLOOK.APPLICATION") Set NewMail = appOutlook.CreateItem(0) With NewMail '.Display .To = ToAddress .Cc = CcAddress .Subject = MailSubject .Body = text .Attachments.Add (FileAttach) .OriginatorDeliveryReportRequested = False .ReadReceiptRequested = False .Send End With Set appOutlook = Nothing Set NewMail = Nothing End If

05/09/2016, 14h48
Jean-Philippe André

Salut,

je pense que la solution proposee ici reste la plus facile
05/09/2016, 14h56
den91240

Merci pour cette réponse mais cela ne répond pas à ma demande.
j'ai déjà vu ce lien.

Bonjour,
si j'ai bien compris, en plus de la pièce jointe, tu veux que le tableau s'affiche dans le corps du mail?

Code:

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
Sub azerty()
Debug.Print RangetoHTML(ActiveSheet.UsedRange)
End Sub
Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2016
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook
 
    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
 
    'Copy the range and create a new workbook to past the data in
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With
 
    'Publish the sheet to a htm file
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With
 
    'Read all data from the htm file into RangetoHTML
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.readall
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")
 
    'Close TempWB
    TempWB.Close savechanges:=False
 
    'Delete the htm file we used in this function
    Kill TempFile
 
    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function

si c'est bien de cela dont il s'agit, il faut faire un envoi en HTML!

http://www.developpez.net/forums/d14...t/#post7968025

Désolé si je n'ai pas été assez clair dans l'explication, donc petite précision :

Tout est fait dans Access.

Dans Access => gestion et analyse des données
Export vers fichier xlsx pour rapport journalier => fichier envoyé en PJ dans le mail
Génération du mail avec :
- Fichier en PJ
- Tableau d'un onglet de ce fichier dans le coprs du mail.

Faire une macro dans xls pour envoyer ce tableau dans le corps du mail je l'ai fait et ça fonctionne bien sauf que là tout est fait dans Access.
Je ne suis pas développeur, j'ai appris par moi-même. Il est possible que mon code ne soit pas complet (variable, commande, etc).
J'ai continué de chercher depuis le dernier post. J'ai adapté mon code avec un envoi en HTML mais celui-ci me renvoi une erreur de "Sub ou variable non définie" .

La procédure :

- Ouverture du fichier xlsx et positionnement sur l'onglet du tableau à insérer dans le mail.

Code:

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
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
'********************
'*    envoi mail    *
'********************
 
Msgb = MsgBox("Voulez-vous envoyer le mail automatique ?", vbYesNo + vbQuestion, "Envoi Mail Automatique")
If Msgb = vbNo Then
Exit Sub
 
Else
 
Dim appOutlook
Dim NewMail
 
'$$$$$$$$$$$$    Ajout Email HTML     $$$$$$$$$$$$$$$$$$$$$
Dim strHTML As String
Dim i As Byte, j As Byte
'$$$$$$$$$$$$
 
Dim FileAttach
Dim MailSubject
 
'$$$$$$$$$$$$    Ajout Email HTML     $$$$$$$$$$$$$$$$$$$$$
' Corps du mail
 
strHTML = ""
strHTML = strHTML & "<HEAD>"
strHTML = strHTML & "<BODY>"
strHTML = strHTML & "Bonjour , <BR>Veuillez trouver xxx en date du " & (Previousday) & ".<BR>Le fichier d'analyse est disponible dans l'emplacement xxx<BR><BR>"
strHTML = strHTML & "<B><SPAN STYLE='background-color:blue;font-size:4mm'>Heure Extraction : 11h </SPAN></B><BR><BR>"
strHTML = strHTML & "<TABLE BORDER>"
 
' Entete tableau xlsx
 
For i = 1 To 1 'nombre de lignes
    strHTML = strHTML & "<TR halign='middle'nowrap>"
    For j = 1 To 5 'nombre de colonnes
        strHTML = strHTML & "<TD bgcolor='blue'align='center'><FONT COLOR='white'SIZE=3>" _
        & Cells(i, j) & "</FONT></TD>"
    Next j
    strHTML = strHTML & "</TR>"
Next i
 
' Ligne tableau xlsx
 
For i = 2 To 7 'nombre de lignes
    strHTML = strHTML & "<TR halign='middle'nowrap>"
    For j = 1 To 5 'nombre de colonnes
        strHTML = strHTML & "<TD bgcolor='white'align='left'><FONT COLOR='black'SIZE=2>" _
        & Cells(i, j) & "</FONT></TD>"
    Next j
    strHTML = strHTML & "</TR>"
Next i
 
strHTML = strHTML & "</TABLE>"
strHTML = strHTML & "<BR><BR>Cordialement,<BR>Signature"
strHTML = strHTML & "</BODY>"
strHTML = strHTML & ""
 
'$$$$$$$$$$$$
 
FileAttach = "Fichier xlsx"
 
 
MailSubject = "Monitoring au " & (Previousday)
 
'Generating and sending an e-mail:
 
Set appOutlook = CreateObject("OUTLOOK.APPLICATION")
Set NewMail = appOutlook.createitem(0)
With NewMail
'.Display
.To = ToAddress
.Cc = CcAddress
.Subject = MailSubject
'.body = text
.HTMLBody = strHTML
.Attachments.Add (FileAttach)
.OriginatorDeliveryReportRequested = False
.ReadReceiptRequested = False
.Send
End With
 
Set appOutlook = Nothing
Set NewMail = Nothing
 
' pour fermer
 
    xlBook.Close
    xlApp.Quit
 
End If

Merci de votre aide ... ça me donne l'impression de ne pas être seul ... :lol:

06/09/2016, 11h22
Invité

Bonjour,
je ne me rappel pas avoir dis que ça devait ce passer dans Excel!

une fonction Excel est applicable dans Access sans avoir besoins de la transposer!

tu envois bien un mais avec Access, le processus est exactement le même dans Excel!

ceci dit car je n'est vraisemblablement rien compris, si tu veux récupérer ton tableaux Excel dans ton mail, il faudra bien qu'a partir d'Access que tu gère Excel!

mais je suis en dehors de la plaque!

Non, tu as bien compris ce que je cherche à faire.

C'est bien à partir d'Access qu'il faut aller chercher un tableau d'un fichier Excel pour le mettre dans un mail automatique.
Pour info j'ai juste préciser que tout doit se faire dans Access car certaines réponses sont propres à Excel.

Quand tu dis "tu envois bien un mail avec Access, le processus est exactement le même dans Excel!"
Eh bien non car je pense qu'il y a des commandes et/ou variables qui diffèrent car le code Excel qui fonctionne ne fonctionne plus dans Access
Encore une fois je ne suis pas un pro dans le domaine.

Avec le code que j'ai mis, dans Access, j'ai une erreur "Sub ou variable non définie" au niveau de cet endroit (en gras) :
Code:

1 2 3 4 5 6 7 8 For i = 1 To 1 'nombre de lignes strHTML = strHTML & "<TR halign='middle'nowrap>" For j = 1 To 5 'nombre de colonnes strHTML = strHTML & "<TD bgcolor='blue'align='center'><FONT COLOR='white'SIZE=3>" _ & Cells(i, j) & "</FONT></TD>" Next j strHTML = strHTML & "</TR>" Next i
Merci de ton aide

06/09/2016, 12h34
Jean-Philippe André

SAlut,

Cells est un objet Excel, pour y acceder tu dois passer par (au choix)
- l'application Excel que tu utilises
- le classeur Excel que tu utilises
- la feuille Excel que tu utilises

Libre a toi de faire a ta sauce, on ne fait que te donner des avis sur des solutions qui ont fait leurs preuves :)

ça je l'ai développé pour Excel, tu le coll dans Access et ça fonctionn sans modif!

Code:

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
Sub Test()
Mail "Sujet", "Message", "Destinataire@gmail.com", Pj:="C:\MyTest\Classeur1.xlsm;C:\MyTest\Classeur11.xlsm", DestinataireCopyCacher:="DestinataireCopyCacher@gmail.com"
Mail "Sujet", "Message", "Destinataire@gmail.com", Pj:="C:\MyTest\Classeur1.xlsm;C:\MyTest\Classeur11.xlsm", DestinataireCopy:="DestinataireCopy.com"
Mail "Sujet", "Message", "Destinataire@gmail.com", DestinataireCopy:="DestinataireCopy.com", DestinataireCopyCacher:="DestinataireCopyCacher@gmail.com"
Mail "Sujet", "Message", "Destinataire@gmail.com", DestinataireCopyCacher:="DestinataireCopyCacher@gmail.com"
Mail "Sujet", "Message", "Destinataire@gmail.com"
End Sub
Sub Mail(Sujet As String, Message As String, Destinataire As String, Optional DestinataireCopy As String, Optional DestinataireCopyCacher As String, Optional Pj As String = "")
Set objOutlook = CreateObject("Outlook.application")
Set MailObj = objOutlook.CreateItem(olMailItem)
With MailObj
    .To = Destinataire
    .CC = DestinataireCopy
    .BCC = DestinataireCopyCacher
    .Subject = Sujet
    .BodyFormat = 2
    .HTMLBody = Message
    If Trim("" & Pj) <> "" Then
        p = Split(Pj & ";", ";")
        For i = 0 To UBound(p)
            If Trim("" & p(i)) <> "" Then .Attachments.Add Trim("" & p(i))
        Next
    End If
    '.Display 'Can be .Send but prompts for user intervention before sending without 3rd party software like ClickYes
    .Send
End With
End Sub

Code:

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
Enum TpXls
    xlPasteValues = -4163
    xlPasteFormats = -4122
    xlHtmlStatic = 0
End Enum
 
Sub test()
Dim xls As Object, Wb As Object
Set xls = CreateObject("Excel.Application")
xls.Visible = True
Set Wb = xls.Workbooks.Open("C:\Users\rdurupt\Desktop\Fichier.xlsx")
Debug.Print RangetoHTML(Wb.Sheets("Feuil1").Range("A1:C3"))
Wb.Close False: Set Wb = Nothing
xls.Quit: Set xls = Nothing
End Sub
Function RangetoHTML(rng As Object)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2016
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook
 
    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
 
    'Copy the range and create a new workbook to past the data in
 
    Set TempWB = rng.Application.Workbooks.Add(1)
     rng.Copy
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        .Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With
 
    'Publish the sheet to a htm file
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With
 
    'Read all data from the htm file into RangetoHTML
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.readall
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")
 
    'Close TempWB
    TempWB.Close savechanges:=False
 
    'Delete the htm file we used in this function
    Kill TempFile
 
    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function

Citation:

Quand tu dis "tu envois bien un mail avec Access, le processus est exactement le même dans Excel!"
Eh bien non car je pense qu'il y a des commandes et/ou variables qui diffèrent car le code Excel qui fonctionne ne fonctionne plus dans Access

les variable objet peuvent être déclarées dans n'importe quel type d'application!