Bonjour,
J'ai déjà trouvé mon bonheur sur le forum concernant la première partie de ma problématique: Envoyer un mail automatique (à 2 semaines) de relance en fonction d'une date.
Cependant pour finaliser mon tableau, je n'arrive pas à envoyer le mail en fonction d'un numéro de semaine à la place d'une date (JJ-MM-AA).
Pouvez-vous m'aider?
Nota : Même avec une méthode détournée, c'est-à-dire que je complète manuellement numéro (format nombre) en colonne B, et la macro se réfère au numéro de semaine (format nombre) de référence que j'inscris en colonne J.
J'espère avoir été clair.
Merci par avance de l'aide que vous pourriez m'apporter.
J'ai déjà trouvé mon bonheur sur le forum concernant la première partie de ma problématique: Envoyer un mail automatique (à 2 semaines) de relance en fonction d'une date.
Cependant pour finaliser mon tableau, je n'arrive pas à envoyer le mail en fonction d'un numéro de semaine à la place d'une date (JJ-MM-AA).
Pouvez-vous m'aider?
Nota : Même avec une méthode détournée, c'est-à-dire que je complète manuellement numéro (format nombre) en colonne B, et la macro se réfère au numéro de semaine (format nombre) de référence que j'inscris en colonne J.
VB:
Sub Email()
Dim outlookDossier As Outlook.MAPIFolder
Dim outlookMessage As Outlook.MailItem
Dim VAdresse As String
Dim VObjet As String
Dim VMessage As String
Dim VCellule As Object
Dim Lig As Long
Dim DateRef
DateRef = DateAdd("ww", 2, Date) ' date semaine +2
Lig = 2
Do While Cells(Lig, 1).Value <> ""
If Cells(Lig, 6).Value = "" Then
VMessage = ""
ClientEnCours = Cells(Lig, 1).Value
VAdresse = Cells(Lig, 5).Value ' adresse du destinataire
While ClientEnCours = Cells(Lig, 1).Value ' On traite les lignes du client
If Cells(Lig, 2).Value < DateRef Then ' date < date de référence
Cells(Lig, 6).Value = "Envoyé"
VMessage = VMessage & " votre facture n° " & Cells(Lig, 4).Value _
& " à échéance " & Format(Cells(Lig, 2).Value, "DD/MM/YYYY") _
& " merci de nous faire un retour avant le " & Cells(Lig, 7).Value _
& " pour un montant de " & Format(Cells(Lig, 3).Value, "# ##0.00 €") _
& " est impayée, " & vbCrLf
VObjet = VObjet & " votre facture n° " & Cells(Lig, 4).Value _
& " est impayée, " & vbCrLf1
End If
Lig = Lig + 1
Wend
If VMessage <> "" Then 'envoyer message si existe
VMessage = "Bonjour," & vbCrLf & vbCrLf & VMessage
VMessage = VMessage & vbCrLf & "Cordialement" 'description
VObjet = " Relance echeance " & vbCrLf1 & VObjet 'object
Set outlookDossier = GetObject("", "Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
Set outlookMessage = outlookDossier.Items.Add
With outlookMessage
.Subject = VObjet
.Recipients.Add VAdresse
.Body = VMessage
.OriginatorDeliveryReportRequested = True
.ReadReceiptRequested = True
.Display
End With
End If
Else
Lig = Lig + 1
End If
Loop
Set outlookMessage = Nothing
Set outlookDossier = Nothing
End SubJ'espère avoir été clair.
Merci par avance de l'aide que vous pourriez m'apporter.
Dernière édition: