Bonjour le forum
j'ai un problème que j'arrive pas à régler, mon code marchait très bien mais depuis hier ça me renvoie un erreur d'excution 1004 Erreur définie par l’application ou l’objet

Mon application génère des envoies de mails, dans le mail j'intégre une copie d'un tableau je mets le code pour l envoie de mail smtp
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
Dim mMessage As Object
Dim mConfig As Object
Dim mChps
Dim rng As Range
 
 
NoteAudit = CStr(NoteAudit)
Set mConfig = CreateObject("CDO.Configuration")
 
Set rng = Range("Data_TDL_tamp[[#All],[Type_Audit]:[Completed]]")
 
mConfig.Load -1
Set mChps = mConfig.Fields
With mChps
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "mailhub.utc.com"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Update
End With
 
Set mMessage = CreateObject("CDO.Message")
With mMessage
Set .Configuration = mConfig
.From = "e-5S@blabla.com"
.To = "tahayassine@Blabla.com"
 
.Subject = "Audit 5s de la zone: " + Login.ComboBox_Zone.Value + " \ " + Login.ListBox_sousZone.Value
.HTMLBody = "Bonjour, " & "<BR>" & _
        "<BR>" & _
        "La zone auditée : " & Login.ComboBox_Zone.Value + " \ " + Login.ListBox_sousZone.Value & "<BR>" & _
        "<BR>" & _
        "Auditeur        : " & Login.Label4.Caption & "<BR>" & _
        "<BR>" & _
        "La note de l'audit est:  " & NoteAudit + "/20" & "<BR>" & _
        "<BR>" & _
        "Le nombre d'actions immédiates réalisées par l'auditeur est : " & nbAction & "<BR>" & _
        "<BR>" & _
        "La To Do List de l'audit: " & "<BR>" & _
        rangetoHTML(rng) & "<BR>" & _    # JE FAIS APPEL à la fonction pour la tableau là
        "Cordialement," & "<BR>" & _
        "<BR>" & _
        "CECI EST UN MAIL AUTOMATIQUE, MERCI DE NE PAS REPONDRE !"
'For i = 0 To k - 1
'txt = txt & vbCrLf & UserForm1.ListBox1.List(ListBox1.ListCount - i - 1, 1) & " (Réf. " & UserForm1.ListBox1.List(ListBox1.ListCount - i - 1, 3) & " : " & UserForm1.ListBox1.List(ListBox1.ListCount - i - 1, 4) & ")"
'Next i
'.TextBody = "Bonjour, " & vbCrLf & vbCrLf & "La zone  : " + Login.ComboBox_Zone.Value + "    " + Login.ListBox_sousZone.Value + " " + " été audité par :  " + Login.Label4.Caption & vbCrLf & vbCrLf & "La note de l'audit est:  " + NoteAudit & vbCrLf & vbCrLf & "Cordialement,"
 
.Send
End With
Set mMessage = Nothing

le code pour range TO HTML
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
Function rangetoHTML(ByVal rng As Range)
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook
 
    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
 
        .Cells(1).PasteSpecial Paste:=12
        .Cells(1).PasteSpecial Paste:=-4122
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
            .DrawingObjects.Visible = True
            .DrawingObjects.Delete
            .Columns.AutoFit
            .Rows.AutoFit
        On Error GoTo 0
    End With
 
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    rangetoHTML = ts.ReadAll
    ts.Close
    rangetoHTML = Replace(rangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")
 
    TempWB.Close savechanges:=False
    Kill TempFile
 
    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
 
End Function
quand je clique sur débogage ça me selectionne ce bloc, help me pleaaase.
Merci