Boucle infinie dans envoie mail avec lotus notes

Bonjour et bon début de semaine,

j'ai un problème sur la ligne de programme suivante, avant j'avais la ligne suivante : For Each rng In Sheets("Sheet1").Range("a2:a20")

sauf que la plage de données qu'on a varie tout le temps, c'est pour cela on a ajouté une commande pour aller au dernier élément du tableau. le doucis c'est que avec cette nouvelle commande, la boucle est infinie, elle compte même les case vide du tableau, donc elle ne s"arrête pas.

For Each rng In Sheets("Sheet1").Range("a2:a" & Sheets("Sheet1").Range("a1").end(xldown).row)

avez vous une solution SVP?

Merci

A bientôt

Bonjour,

Tu copies ce code et tu lances la macro "test".

Quel est le nombre affiché?

Public Sub test()
Dim ws As Worksheet
Dim lngRow As Long
    Set ws = Worksheets("Sheet1")
    With ws
        lngRow = .Range("A" & Rows.Count).End(xlUp).Row
        MsgBox lngRow
    End With
    Set ws = Nothing
End Sub

Bonjour,

Merci Jean eric,

il affiche nombre ambigu

je te met en Pj le fichier. si tu as des remarques

A+

Re bonjour,

est ce quelqu'un aura une idée pour ce poblème?

merci

@+

Re,

Pour la première partie, à tester:

Public Sub test()
Dim rng As Range
    For Each rng In Sheets("Sheet1").Range("A2:A20")
        If (Now() - rng.Offset(0, 1)) * 24 > 48 And rng.Offset(0, 2).Value = "" Then
            'Call send_email(rng.Value, rng.Row)
            MsgBox rng.Value & "ligne: " & rng.Row
        End If
    Next
End Sub

Pour le reste, et pour les cellules clignotantes, je ne sais pas.

Cdlt

Re,

Merci pour le code, mais le problème est toujours le même, il prend que la plage A2:A20 et non pas de A2 jusqu’au la fin du tableau

Merci

A plus

bonsoir,

essaie ceci

da=Sheets("sheet1").Range("a" & Rows.Count).End(xlUp).Address
msgbox "dernière adresse mail trouvée en " & da
For Each rng In Sheets("Sheet1").Range("a2:" & da )

Bonjour,

il m'afiche le msgBox mais aprés erreur..

 Public Sub test()
    Dim rng As Range

    da = Sheets("sheet1").Range("a" & Rows.Count).End(xlUp).Address
    MsgBox "dernière adresse mail trouvée en " & da
    For Each rng In Sheets("Sheet1").Range("a2:" & da)

            If (Now() - rng.Offset(0, 1)) * 24 > 48 And rng.Offset(0, 2).Value = "" Then
                Call send_email(rng.Value, rng.Row)
               MsgBox rng.Value & "ligne: " & rng.Row
            End If
        Next
    End Sub

la ligne

If (Now() - rng.Offset(0, 1)) * 24 > 48 And rng.Offset(0, 2).Value = "" Then

qui se mets en jaune.

que pensez vous?

Bonjour,

je te confirme que le code fonctionne sur le fichier joint.

tu reçois cette erreur car il n'y a pas de données en colonne B pour une ou plusieurs lignes.

quelle est l'adresse affichée par le msgbox ? as-tu vérifié le contenu de cette cellule ?

Re,

le msgBox affiche $A$1,

j'ai remis le fichier en Pj (j'ai fais des modifications selon le besoin)

le fait d'afficher ou se trouver le dernier élément n'a pas d'importance

Merci a vous

@+

Bonjour,

il faut bien sur remettre les adresses mail que tu as enlevées avant de lancer la macro. j'ai déduit que ces adresses mail se trouvaient en colonne A, si ce n'est pas la cas la macro doit être adaptée.

Re bonjour,

j'ai mis l'adresse mail du destinataire dans le programme puisque c'est toujours le même.

ça ne suffit pas?

Merci

A+

Bonjour,

comme la colonne déterminante pour le nombre de lignes n'est pas la colonne A mais la colonne B, adapte le code comme suit

    Public Sub test()
    Dim rng As Range

    da = Sheets("sheet1").Range("b" & Rows.Count).End(xlUp).Address
    For Each rng In Sheets("Sheet1").Range("b2:" & da)

            If (Now() - rng) * 24 > 48 And rng.Offset(0, 1).Value = "" Then
                Call send_email(rng.Value, rng.Row)
               MsgBox rng.Value & "ligne: " & rng.Row
            End If
        Next
    End Sub

re,

il y a une erreur : erreur d'exécution '7294':

Impossible d'envoyer du courrier, car aucune correspondance n'a été trouvée dans les carnets d'adresses.

et cette ligne qui se met en jaune:

.Send 0, emailto

Bonjour,

je ne connais pas ces instructions spécifiques à lotus notes.

ce que je peux te dire c'est de regarder le contenu de emailto ( à mon avis ceci doit contenir une addresse email du destinataire) or les adaptations que tu a faites à ton code y mettent une date.

moi j'essaierai de mettre

.send 

à la place de

.send 0,emailto

Bonjour,

avec le code suivant ça marche parfait sauf que la plage d’exécution est limité à (a2:a20) et non pas jusqu’au dernier élément de cette colonne

Sub test()
Dim rng As Range

For Each rng In Sheets("Sheet1").Range("a2:a20")

If Application.WorksheetFunction.Text(VBA.Now() - rng.Offset(0, 1).Value, "[HH]") * 1 > 48 And rng.Offset(0, 2).Value = "" Then
Call send_email(rng.Value, rng.Row)

End If

Next

End Sub

Sub send_email(emailto As String, ROWNO As Long)
Dim noSession As Object
Dim noDatabase As Object
Dim noDocument As Object
'Instantiate the Lotus Notes COM's Objects.
Set noSession = CreateObject("Notes.NotesSession")
Set noDatabase = noSession.GETDATABASE("", "")

'If Lotus Notes is not open then open the mail-part of it.
If noDatabase.IsOpen = False Then noDatabase.OPENMAIL

'Create the e-mail and the attachment.
Set noDocument = noDatabase.CreateDocument

With noDocument
.Form = "Memo"
.SendTo = "otmano@gmail.com"
.Subject = "Alarme non validation projet dans la ligne " & ROWNO
.Body = "Bonjour," & vbNewLine & vbNewLine & vbNewLine & "Pensez SVP a valider le dossier dans la ligne " & ROWNO & vbNewLine & vbNewLine & vbNewLine & " Cordialement"
.SaveMessageOnSend = True
.PostedDate = Now()
.Send 0, emailto
End With
Set noDocument = Nothing
Set noDatabase = Nothing
Set noSession = Nothing

End Sub

as-tu au moins essayé la solution que je t'ai proposée ?

voici un code adapté qui détermine le range A en fonction de B

pour ton information dans ce cas-ci, emailto ne contiendra rien.

   

Sub test()
Dim rng As Range
da = Sheets("sheet1").Range("B" & Rows.Count).End(xlUp).row
For Each rng In Sheets("Sheet1").Range("a2:a" & da)

If Application.WorksheetFunction.Text(VBA.Now() - rng.Offset(0, 1).Value, "[HH]") * 1 > 48 And rng.Offset(0, 2).Value = "" Then
Call send_email(rng.Value, rng.Row)

End If

Next

End Sub

Sub send_email(emailto As String, ROWNO As Long)
Dim noSession As Object
Dim noDatabase As Object
Dim noDocument As Object
'Instantiate the Lotus Notes COM's Objects.
Set noSession = CreateObject("Notes.NotesSession")
Set noDatabase = noSession.GETDATABASE("", "")

'If Lotus Notes is not open then open the mail-part of it.
If noDatabase.IsOpen = False Then noDatabase.OPENMAIL

'Create the e-mail and the attachment.
Set noDocument = noDatabase.CreateDocument

With noDocument
.Form = "Memo"
.SendTo = "otmano@gmail.com"
.Subject = "Alarme non validation projet dans la ligne " & ROWNO
.Body = "Bonjour," & vbNewLine & vbNewLine & vbNewLine & "Pensez SVP a valider le dossier dans la ligne " & ROWNO & vbNewLine & vbNewLine & vbNewLine & " Cordialement"
.SaveMessageOnSend = True
.PostedDate = Now()
.Send 0, emailto
End With
Set noDocument = Nothing
Set noDatabase = Nothing
Set noSession = Nothing

End Sub

Bonjour,

oui bien sur c'est la premiere chose que j'ai fais est d'essayer ta solution en mettant .Send

j'essayerai cette dernière solution

Bonjour,

ça marche Merciii

est ce que tu as des idées concernant le reste qui est marqué dans le fichier?

aussi j'ai une question pour mettre une PJ, j'ai essayé d'ajouter .Attachments "chemin du fichier" mais il ne la pas pris.

Merci encore

A+

otmano a écrit :

(...)

est ce que tu as des idées concernant le reste qui est marqué dans le fichier?

(...)

je ne vois pas de quoi tu parles.

Bonjour,

dans le fichier que j'ai mis en PJ, il y a une zone de texte avec quelques questions qui sont :

Sera t-il possible de mettre les cases en retard clignotant en rouge? savez vous comment ajourter une PJ au mail?

Merci