Bonjour, j’étais heureuse d’avoir réussi à programmer l’envoi de relances automatiques mail mais je n’arrive pas à mettre en forme le tableau du détail des encours de mes clients. Pour le moment l’envoi sous la forme ci-dessous mais je voudrais ajouter une en-tête et je n’y arrive pas ça fait tout bugger :
***Madame Monsieur, ***
Sauf erreur de notre part, nous n’avons toujours pas enregistré de règlement de la ou des facture(s) échue(s) dans votre encours ci-dessous :
***274 AUTORHON 08/04/2023 AV 873877 31/05/2023 -3000 ***
***274 AUTORHON 22/04/2023 FA 873962 30/06/2023 37,19 ***
***274 AUTORHON 28/04/2023 RG 841439 28/04/2023 -72,25 ***
***274 AUTORHON 13/07/2023 AV 874383 31/08/2023 -127,19 ***
***274 AUTORHON 05/10/2023 FA 874847 30/11/2023 727,67 ***
***274 AUTORHON 11/10/2023 FA 874860 30/11/2023 22,18 ***
***274 AUTORHON 17/10/2023 FA 874917 31/12/2023 35,09 ***
***274 AUTORHON 18/10/2023 FA 874921 31/12/2023 319,28 ***
***274 AUTORHON 26/10/2023 FA 874947 31/12/2023 41,28 ***
***Nous vous saurions gré d’en régulariser leur paiement ou de nous faire part de tout motif qui s’y opposerait. ***
Si un règlement nous était déjà parvenu, vous voudrez bien nous en informer et considérer ce rappel comme nul et non avenu.
***Je me tiens à votre disposition pour tout complément d’information. ***
***Cordialement, ***
***Mahault F ***
***Direction Administrative et Financière *** Tél : 0000000000 Mail : m.f@jegalerenmacro.fr
Bonjour et merci pour votre réponse. Effectivement un fichier et je relis les instructions le code VBA dans le corps du message… Désolée. D’avance merci pour votre aide. Fichier macro pour formule excel.xlsm (23,2 Ko)
Sub EnvoyerEmails()
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Dim lLastRow As Long
Dim sBody As String
Dim sTable As String
Dim ProcessedClients As Collection
Dim ProcessedTransactions As Collection
Set OutApp = CreateObject(« Outlook.Application »)
Set ProcessedClients = New Collection
Set ProcessedTransactions = New Collection
lLastRow = ThisWorkbook.Sheets(« Feuil1 »).Cells(ThisWorkbook.Sheets(« Feuil1 »).Rows.Count, « A »).End(xlUp).Row
For Each cell In ThisWorkbook.Sheets(« Feuil1 »).Range(« A2:A » & lLastRow)
On Error Resume Next
ProcessedClients.Add cell.Value, CStr(cell.Value)
If Err.Number = 0 Then
sTable = CreateMailTable(cell, ProcessedTransactions)
sBody = « Madame Monsieur, » & vbNewLine & vbNewLine & _
« Sauf erreur de notre part, nous n’avons toujours pas enregistré de règlement de la ou des facture(s) échue(s) dans votre encours ci-dessous : » & vbNewLine & _
sTable & vbNewLine & _
« Nous vous saurions gré d’en régulariser leur paiement ou de nous faire part de tout motif qui s’y opposerait. » & vbNewLine & _
« Si un règlement nous était déjà parvenu, vous voudrez bien nous en informer et considérer ce rappel comme nul et non avenu. » & vbNewLine & _
« Je me tiens à votre disposition pour tout complément d’information. » & vbNewLine & vbNewLine & _
« Cordialement, » & vbNewLine & vbNewLine & _
« Mahaut f » & vbNewLine & _
« Direction Administrative et Financière » & vbNewLine & _
« Département Comptabilité Clients » & vbNewLine & _
« Financial Department » & vbNewLine & _
« Accounting Receivable Department » & vbNewLine & _
« Tél. : +33 00 00 00 00 00 » & vbNewLine & _
« Fax : +33 00 00 00 00 00 » & vbNewLine & _
« Email : m.f@jegalerenmacro.fr »
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = cell.Offset(0, 8).Value
.Subject = « RELANCE URGENTE »
.Body = sBody
.Display
End With
cell.Offset(0, 11).Value = « Envoyé »
PrevClient = cell.Value
End If
On Error GoTo 0
While cell.Value = cell.Offset(1, 0).Value
Set cell = cell.Offset(1, 0)
Wend
Next cell
Set OutApp = Nothing
Set ProcessedClients = Nothing
End Sub
Function CreateMailTable(clientCell As Range, ByRef ProcessedTransactions As Collection) As String
Dim r As Range
Dim c As Range
Dim sRow As String
Dim sTable As String
Dim client As String
Dim transactionId As String
client = clientCell.Value
Set r = clientCell
While r.Value = client
transactionId = r.Cells(1, 3).Value
On Error Resume Next
ProcessedTransactions.Add transactionId, CStr(transactionId)
If Err.Number = 0 Then
sRow = « »
For Each c In r.Resize(1, 7)
sRow = sRow & c.Value & vbTab
Next c
sTable = sTable & sRow & vbNewLine
End If
On Error GoTo 0
Set r = r.Offset(1, 0)
Wend
CreateMailTable = sTable
End Function
j’avais un problème de décalage entre les entêtes et le tableau, donc je l’ai fait avec un JPG dans le body. Voir macro « Mail_Avec_Image » Fichier macro pour formule excel.xlsm (33,3 Ko)
