Autres Envoi mail automatique (suivant numéro de la semaine)

[Nikoko]

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.

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 Sub

J'espère avoir été clair.

Merci par avance de l'aide que vous pourriez m'apporter.

 

[sylvanu]

Bonjour Nikoko,
Essayez de rajouter une condition avec le N° de semaine en cours en la comparant avec celui de la colonne B :

....
Lig = 2
Do While Cells(Lig, 1).Value <> ""
  If Cells(Lig, "F") = "" And Application.WeekNum(Now) = Cells(Lig, "B") Then
....

 

[Nikoko]

Bonjour Sylvanu,
Je vais essayer de travailler avec ton code sur la marco.

Merci pour le retour.