Discussion :

[ullyse31]

Bonjour à tous,
Je viens vers vous car j’aurais besoin d’aide afin d’envoyer un mail outlook via une macro en fonction de données du TCD suivant





Voici le code que j'ai essayé mais ça ne marche pas et je ne comprends pas pourquoi

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
Sub macor()
Dim Objet As String
Dim OutlookApp As Object
Dim OutlookMail As Object
 
 
    'Initialisation des variables
 
    Objet = "pointage factures"
 
 
    Set OutlookApp = CreateObject("outlook.application")
    Set OutlookMail = OutlookApp.createitem(0)
 
 
    With OutlookMail
        .To = Range("B3")
        .Subject = Objet
        .body = "Bonjour," & vbCrLf & "Vous n'avez pas pointé les factures des périodes suivantes: " & vbCrLf &  Range("A7:A20") & vbCrLf  & "Bien cordialement"
        .Display
 
 
 
    End With
 
End Sub

Je ne comprends pas pourquoi pas ça ne marche pas. J’ai mis Range("A7:A20") car le nombre de factures à pointer peut varier de 1 à 13.
PS : voici la base de données utilisée si ça peut vous aider pour mieux comprendre le problème





Merci de votre aide, je débute sur VBA

[joe.levrai]

Bonjour,


ça ne marche pas, c'est très vague.

Si tu veux insérer une plage (et non une simple cellule) dans le corps du mail, il faut la convertir en HTML

voici une fonction pour ça :

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
Function RangetoHTML(ByVal Rng As Range)
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook
 
    TempFile = VBA.Environ$("temp") & "\" & VBA.Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
    Rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=12
        .Cells(1).PasteSpecial Paste:=-4122
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
            .DrawingObjects.Visible = True
            .DrawingObjects.Delete
            .Columns.AutoFit
        On Error GoTo 0
    End With
 
    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
 
    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=")
    TempWB.Close savechanges:=False
    Kill TempFile
 
    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function

et un exemple d'appel :

Code :

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

1
2
3
4
5
6
With OutlookMail
    .To = Range("B3").Value
    .Subject = Objet
    .body = "Bonjour," & vbCrLf & "Vous n'avez pas pointé les factures des périodes suivantes: " & vbCrLf & RangetoHTML(Range("A7:A20")) & vbCrLf & "Bien cordialement"
    .Display
End With

Par ailleurs, je te conseille de préfixer tes ranges par la feuille qui les contient