Bonjour à tous ,

j'avais une erreur sur le fonctionnement d'une macro qui me disait erreur 91
variable objet ou variable bloc With non definie en mettant la ligne
Code : Sélectionner tout - Visualiser dans une fenêtre à part
MonTo = Sheets("emails").Cells(MaRech.Row, 2) & Chr(64) & Sheets("emails").Cells(MaRech.Row, 3)
en jaune
J'ai activé alors la bibliothèque cdo pour windows 2000 et elle a fonctionné pendant une semaine . Depuis hier elle ne fonctionne à nouveau plus en me remettant c'ette même erreur (en fait elle envoie 1 seul message qui est la 1ere ligne "pas livrée ?" trouvée ) Pourriez vous m'aider à comprendre
Voici le code
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
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
Sub Mail()
'--------------------------------------------------------------------------------------
' Procedure : Envoi Mail Avec CDO2000; vérifier si référencé (Microsoft CDO...)
' Author    : Fred Vandermeulen
' Date      : 16/10/2009
' Purpose   : Envoi un mail sans message de sécurité (validation)
' Method:   : Déclaration tardive ("Late Binding")
' Microsoft CDO for Windows 2000 Library
'---------------------------------------------------------------------------------------
Dim Cdo_Message As Object
Set Cdo_Message = CreateObject("CDO.Message")
Const CdoTo = 1
Const CdoCc = 2
Const CdoBcc = 3
 
Dim DerLig As Long, r As Long, DerLig2 As Long
Dim MonTo As String, MonText As String
Dim MaRech As Range, MaPlage As Range
DerLig = Sheets("globale").Cells(Columns(17).Cells.Count, 17).End(xlUp).Row
DerLig2 = Sheets("emails").Cells(Columns(1).Cells.Count, 1).End(xlUp).Row
Sheets("emails").Select 'Obligatoire pour la ligne suivante
Set MaPlage = Sheets("emails").Range(Cells(2, 1), Cells(DerLig2, 1))
 
Sheets("globale").Select 'Obligatoire pour la recherche
For r = 1 To DerLig 'Boucle sur les lignes depuis la ligne 1, si il y a des titres alors changer 1 par 2
    If Sheets("globale").Cells(r, 17) = "pas livrée ?" Then 'Attention syntaxe importante, éventuellement vérifier si non vide (moins de risque)
        With MaPlage
            Set MaRech = .Find(Sheets("globale").Cells(r, 10).Value, LookIn:=xlValues) 'Récupère l'address de la cellule qui répond à la recherche
           MonTo = Sheets("emails").Cells(MaRech.Row, 2) & Chr(64) & Sheets("emails").Cells(MaRech.Row, 3) 'Récupère l'adresse e-mail par concaténation de la colonne 2 et 3
            MonText = Sheets("emails").Cells(MaRech.Row, 5) 'récupère le texte dans la colonne E (N°5)
        End With
        Set Cdo_Message.Configuration = GetSMTPServerConfig() 'Appelle la Function
        With Cdo_Message
            .To = MonTo 'Récupère la variable du destinataire
            .From = "philippe.lohr" & Chr(64) & "mondia.fr" 'Mettre addresse e-mail
            .Subject = "Wincanton delivery " & Sheets("globale").Cells(r, 2) 'Récupère le sujet
            .TextBody = MonText 'Récupère le corps du message
            '.AddAttachment ("c:cheminfichier.ext")
            .Cc = "philippe.lohr" & Chr(64) & "mondia.fr"
            .Send
        End With
    End If
Next r
Set Cdo_Message = Nothing
End Sub
 
Function GetSMTPServerConfig() As Object
' Microsoft CDO for Windows 2000 Library
    Const cdoSendUsingPickup = 1
    Const cdoSendUsingPort = 2
    Const cdoSendUsingMethod = "http://schemas.microsoft.com/cdo/configuration/sendusing"
    Const cdoSMTPServer = "http://schemas.microsoft.com/cdo/configuration/smtpserver"
    Const cdoSMTPServerPort = "http://schemas.microsoft.com/cdo/configuration/smtpserverport"
 
    Dim Cdo_Config As Object 'New CDO.Configuration
    Set Cdo_Config = CreateObject("CDO.Configuration")
    Dim Cdo_Fields As Object
    Set Cdo_Fields = Cdo_Config.Fields
 
    With Cdo_Fields
        .Item(cdoSendUsingMethod) = cdoSendUsingPort
        .Item(cdoSMTPServer) = "smtp.fr.oleane.com" 'Adapter l'adresse SMTP (voir Outlook)
        .Item(cdoSMTPServerPort) = 25
        .Update
    End With
 
    Set GetSMTPServerConfig = Cdo_Config
    Set Cdo_Config = Nothing
    Set Cdo_Fields = Nothing
 
End Function
Je joins le fichier avec