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

**den91240** · 05/09/2016, 14h41

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

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

Salut,

je pense que la solution proposee ici reste la plus facile

**den91240** · 05/09/2016, 14h56

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

Invité · 05/09/2016, 16h26

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**den91240** · 06/09/2016, 11h02

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 ...

Invité · 06/09/2016, 11h22

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!

Envoi mail depuis Access avec tableau Excel dans le corps du mail [AC-2010]

VBA Access

Vue hybride

Discussions similaires

Partager

Partager