Perte des données dans macro

Le 29/05/2017 à 14:52

Bonjour a tous,

Voici mon problème:

J'ai une macro qui envoie un email avec beaucoup de variable:

Sub EnvoiSimple()

'déclaration des variables
    Dim OutApp As Object
    Dim OutMail As Object

'
DerL = Range("A" & Rows.Count).End(xlUp).Row
corps = ""
entete = "Bonjour" & ThisWorkbook.Sheets("Administrateur").Range("R17").Value & ThisWorkbook.Sheets("Administrateur").Range("S17").Value & vbCrLf & vbCrLf & "Voici la liste du personnelle aillant besoin d'un renouvellement quelquonque: " & vbCrLf

For i = 2 To DerL

      If ThisWorkbook.Sheets("DRH").Range("C" & i) = "1" Then
        Message = "Badge rouge"
        corps = corps & ThisWorkbook.Sheets("DRH").Range("A" & i).Value & " - " _
                      & ThisWorkbook.Sheets("DRH").Range("A1").Value & " - " _
                      & ThisWorkbook.Sheets("DRH").Range("B" & i).Value & Chr(13)

      End If

      If ThisWorkbook.Sheets("DRH").Range("C" & i) = "2" Then
        Message = "Badge rouge"
        corps = corps & ThisWorkbook.Sheets("DRH").Range("A" & i).Value & " - " _
                      & ThisWorkbook.Sheets("DRH").Range("A1").Value & " - " _
                      & ThisWorkbook.Sheets("DRH").Range("B" & i).Value & Chr(13)

      End If

      If ThisWorkbook.Sheets("DRH").Range("F" & i) = "1" Then

        corps = corps & ThisWorkbook.Sheets("DRH").Range("D" & i).Value & " - " _
                      & ThisWorkbook.Sheets("DRH").Range("D1").Value & " - " _
                      & ThisWorkbook.Sheets("DRH").Range("E" & i).Value & Chr(13)

      End If

       If ThisWorkbook.Sheets("DRH").Range("F" & i) = "2" Then

        corps = corps & ThisWorkbook.Sheets("DRH").Range("D" & i).Value & " - " _
                      & ThisWorkbook.Sheets("DRH").Range("D1").Value & " - " _
                      & ThisWorkbook.Sheets("DRH").Range("E" & i).Value & Chr(13)

      End If
       If ThisWorkbook.Sheets("DRH").Range("I" & i) = "1" Then
        Message = "Médecine du travail"
        corps = corps & ThisWorkbook.Sheets("DRH").Range("G" & i).Value & " - " _
                      & ThisWorkbook.Sheets("DRH").Range("G1").Value & " - " _
                      & ThisWorkbook.Sheets("DRH").Range("H" & i).Value & Chr(13)

      End If

         If ThisWorkbook.Sheets("DRH").Range("I" & i) = "2" Then
        Message = "Médecine du travail"
        corps = corps & ThisWorkbook.Sheets("DRH").Range("G" & i).Value & " - " _
                      & ThisWorkbook.Sheets("DRH").Range("G1").Value & " - " _
                      & ThisWorkbook.Sheets("DRH").Range("H" & i).Value & Chr(13)

      End If
Next i

            Set OutApp = CreateObject("Outlook.Application")

            Set OutMail = OutApp.CreateItem(0)

            On Error Resume Next
            With OutMail
                'destinataires
                 '.From = "Essai from"

                 .To = ThisWorkbook.Sheets("Administrateur").Range("U17").Value
                '.To = "test"
                '.CC = ThisWorkbook.Sheets("Envoi Mail").Range("B3").Value
                '.BCC = ""
                'objet du mail
                 .Subject = "Alerte Badge rouge"
                ' corps du message
                 .Body = entete & corps
                 .Message = badge_rouge

                ' fichier en pièce jointe
                 'Feuile de calcul
                '.Attachments.Add ActiveWorkbook.FullName
                'Fichier du disque dur
                '.Attachments.Add "C:\****\****\****\**\NomFichier.Ext"
                'Ou
                '.Attachments.Add ThisWorkbook.Sheets("Feuil1").Range("H20").Value

                .Send
             End With
             On Error GoTo 0
             Set OutMail = Nothing
             Set OutApp = Nothing

    'fermer le classeur à la fin
    'ThisWorkbook.Close
End Sub
'

le problème est quand je modifie la ligne (entete="Bonjour" & ....) soit par le code de la macro en elle meme ou bien modifier les variables directement sur l'onglet (car elle prend des variables sur l'onglet Administrateur) le mail s'envoie mais toute le code suivant ne fonctionne plus:

For i = 2 To DerL

      If ThisWorkbook.Sheets("DRH").Range("C" & i) = "1" Then
        Message = "Badge rouge"
        corps = corps & ThisWorkbook.Sheets("DRH").Range("A" & i).Value & " - " _
                      & ThisWorkbook.Sheets("DRH").Range("A1").Value & " - " _
                      & ThisWorkbook.Sheets("DRH").Range("B" & i).Value & Chr(13)

      End If

      If ThisWorkbook.Sheets("DRH").Range("C" & i) = "2" Then
        Message = "Badge rouge"
        corps = corps & ThisWorkbook.Sheets("DRH").Range("A" & i).Value & " - " _
                      & ThisWorkbook.Sheets("DRH").Range("A1").Value & " - " _
                      & ThisWorkbook.Sheets("DRH").Range("B" & i).Value & Chr(13)

      End If

      If ThisWorkbook.Sheets("DRH").Range("F" & i) = "1" Then

        corps = corps & ThisWorkbook.Sheets("DRH").Range("D" & i).Value & " - " _
                      & ThisWorkbook.Sheets("DRH").Range("D1").Value & " - " _
                      & ThisWorkbook.Sheets("DRH").Range("E" & i).Value & Chr(13)

      End If

       If ThisWorkbook.Sheets("DRH").Range("F" & i) = "2" Then

        corps = corps & ThisWorkbook.Sheets("DRH").Range("D" & i).Value & " - " _
                      & ThisWorkbook.Sheets("DRH").Range("D1").Value & " - " _
                      & ThisWorkbook.Sheets("DRH").Range("E" & i).Value & Chr(13)

      End If
       If ThisWorkbook.Sheets("DRH").Range("I" & i) = "1" Then
        Message = "Médecine du travail"
        corps = corps & ThisWorkbook.Sheets("DRH").Range("G" & i).Value & " - " _
                      & ThisWorkbook.Sheets("DRH").Range("G1").Value & " - " _
                      & ThisWorkbook.Sheets("DRH").Range("H" & i).Value & Chr(13)

      End If

         If ThisWorkbook.Sheets("DRH").Range("I" & i) = "2" Then
        Message = "Médecine du travail"
        corps = corps & ThisWorkbook.Sheets("DRH").Range("G" & i).Value & " - " _
                      & ThisWorkbook.Sheets("DRH").Range("G1").Value & " - " _
                      & ThisWorkbook.Sheets("DRH").Range("H" & i).Value & Chr(13)

      End If

Auriez vous une idée pour m'aider?

PS: pour envoyer l'email sur votre boite mail pour tester, il faut la modifier dans l'onglet administrateur cellule U17

Cordialement

5status-igo-2.xlsm (166.16 Ko)
Le 29/05/2017 à 16:21

Bonjour,

Tu peux peut-être commencer par nous dire à quoi correspondent DerL et badge_rouge ?

Cdlt.

Le 29/05/2017 à 16:26

Bonjour,

C 'est une très bonne question DerL je ne sais pas, j'avais demandé de l'aide pour un envoie de mail avec variable et on m'avait sorti ce code, maintenant je ne suis pas contre le changer si c'est le problème.

Message = "Badge rouge"peux être enlevé je me suis rendu compte qu'il n'apparaissait pas dans le mail, (je l'avait laissez pour me retrouver un peux plus dans les variables).

Pour voir le problème, remplacé dans l'onglet Administrateur "Allion" en Cellule S17 par "monsieur Allion", et la toute mes variables disparais... en executant la macro envoieSimple

Le 21/12/2017 à 17:06

Bonjour,

Personne ne peux m'aidé ?

Rechercher des sujets similaires à "perte donnees macro"