"Príliš veľký postup" Chyba - excel, excel-vba, vba

Sub Create_Mail_From_List_Exams()

Dim OutApp  As Object
Dim OutMail As Object
Dim cell As Range
Dim bodymessage  As String
Dim bodymessage1 As String
Dim bodymessage2 As String
Dim bodymessage3 As String
Dim bodymessage4  As String
Dim bodymessage5 As String
Dim Bodymessage6 As String
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")

On Error GoTo cleanup
Dim i As Integer
Dim j As Integer
For i = 3 To ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row

bodymessage = ""
bodymessage1 = ""
bodymessage2 = ""
bodymessage3 = ""
bodymessage4 = ""
bodymessage5 = ""
ex6 = ""
ex7 = ""
ex8 = ""

fr1 = ""
fr2 = ""
fr3 = ""
fr4 = ""
fr5 = ""
fr6 = ""
fr7 = ""
fr8 = ""
fr9 = ""

"ActiveSheet.Cells(1, 12) = ActiveSheet.Cells(1, 12) & "(" & cell.Row & "," & cell.Column & "), "

If Sheets("Exams-email results").Cells(i, 3).Text Like "?*@?*.?*" And _
LCase(Cells(i, "M").Value) = "dnm" Then

Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail

.To = ActiveSheet.Cells(i, 3).Text



.Subject = Sheets("Exams-email results").Range("T2") & " / " & Sheets("Exams-email results").Range("T5")


"& "Groupe  " & ActiveSheet.Cells(i, 10).Text & "  / Niveau " & ActiveSheet.Cells(i, 11).Text"

"A"

If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("D3").Text = "Educ" Then

bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B7").Text
End If


If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("D3").Text = "A1" Then

bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B26").Text

End If

If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("D3").Text = "A2" Then

bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B27").Text

End If

If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("D3").Text = "A3" Then

bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B28").Text

End If
If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("D3").Text = "A4" Then

bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B29").Text

End If
If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("D3").Text = "A5" Then

bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B30").Text

End If

If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("D3").Text = "A6" Then

bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B31").Text

End If

If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("D3").Text = "A7" Then

bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B32").Text

End If

If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("D3").Text = "A8" Then

bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B33").Text

End If

"k"

If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("D3").Text = "K1" Then

bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B20").Text

End If

If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("D3").Text = "K2" Then

bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B21").Text

End If
If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("D2").Text = "K3" Then

bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B22").Text

End If


If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("D3").Text = "K4" Then

bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B23").Text

End If


If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("D3").Text = "K5" Then

bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B24").Text

End If



"PS"




If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("D3").Text = "PS1" Then

bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B35").Text
End If




If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("D3").Text = "PS2" Then

bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B36").Text
End If



If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("D3").Text = "PS3" Then

bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B37").Text
End If

If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("D3").Text = "PS4" Then

bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B38").Text
End If

If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("D3").Text = "PS5" Then

bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B39").Text
End If

If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("D3").Text = "PS6" Then

bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B40").Text
End If

If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("D3").Text = "PS7" Then

bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B41").Text
End If

If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("D3").Text = "PS8" Then

bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B42").Text
End If





"EXAM2"



If LCase(Cells(i, "E").Text) = "dnm" And Sheets("Exams-email results").Range("E3").Text = "Educ" Then

bodymessage1 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B7").Text
End If


If LCase(Cells(i, "E").Text) = "dnm" And Sheets("Exams-email results").Range("E3").Text = "A1" Then

bodymessage1 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B26").Text
End If


If LCase(Cells(i, "E").Text) = "dnm" And Sheets("Exams-email results").Range("E3").Text = "A2" Then

bodymessage1 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B27").Text
End If


If LCase(Cells(i, "E").Text) = "dnm" And Sheets("Exams-email results").Range("E3").Text = "A3" Then

bodymessage1 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B28").Text
End If


If LCase(Cells(i, "E").Text) = "dnm" And Sheets("Exams-email results").Range("E3").Text = "A4" Then

bodymessage1 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B29").Text
End If


If LCase(Cells(i, "E").Text) = "dnm" And Sheets("Exams-email results").Range("E3").Text = "A5" Then

bodymessage1 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B30").Text
End If


If LCase(Cells(i, "E").Text) = "dnm" And Sheets("Exams-email results").Range("E3").Text = "A6" Then

bodymessage1 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B31").Text
End If
If LCase(Cells(i, "E").Text) = "dnm" And Sheets("Exams-email results").Range("E3").Text = "A7" Then

bodymessage1 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B32").Text
End If
If LCase(Cells(i, "E").Text) = "dnm" And Sheets("Exams-email results").Range("E3").Text = "A8" Then

bodymessage1 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B33").Text
End If






"k"


If LCase(Cells(i, "E").Text) = "dnm" And Sheets("Exams-email results").Range("E3").Text = "K1" Then

bodymessage1 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B20").Text
End If





If LCase(Cells(i, "E").Text) = "dnm" And Sheets("Exams-email results").Range("E3").Text = "K2" Then

bodymessage1 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B21").Text
End If



If LCase(Cells(i, "E").Text) = "dnm" And Sheets("Exams-email results").Range("E3").Text = "K3" Then

bodymessage1 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B22").Text
End If


If LCase(Cells(i, "E").Text) = "dnm" And Sheets("Exams-email results").Range("E3").Text = "K4" Then

bodymessage1 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B23").Text
End If

If LCase(Cells(i, "E").Text) = "dnm" And Sheets("Exams-email results").Range("E3").Text = "K5" Then

bodymessage1 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B24").Text
End If

"ps1"


If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("E3").Text = "PS1" Then

bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B35").Text
End If

If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("E3").Text = "PS2" Then

bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B36").Text
End If

If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("E3").Text = "PS3" Then

bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B37").Text
End If

If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("E3").Text = "PS4" Then

bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B38").Text
End If

If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("E3").Text = "PS5" Then

bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B39").Text
End If

If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("E3").Text = "PS6" Then

bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B40").Text
End If

If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("E3").Text = "PS7" Then

bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B41").Text
End If

If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("E3").Text = "PS8" Then

bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B42").Text
End If





"Exam3"



If LCase(Cells(i, "F").Text) = "dnm" And Sheets("Exams-email results").Range("F3").Text = "Educ" Then

bodymessage2 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B7").Text
End If


If LCase(Cells(i, "F").Text) = "dnm" And Sheets("Exams-email results").Range("F3").Text = "A1" Then

bodymessage2 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B26").Text
End If


If LCase(Cells(i, "F").Text) = "dnm" And Sheets("Exams-email results").Range("F2").Text = "A2" Then

bodymessage2 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B27").Text
End If


If LCase(Cells(i, "F").Text) = "dnm" And Sheets("Exams-email results").Range("F2").Text = "A3" Then

bodymessage2 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B28").Text
End If


If LCase(Cells(i, "F").Text) = "dnm" And Sheets("Exams-email results").Range("F2").Text = "A4" Then

bodymessage2 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B29").Text
End If


If LCase(Cells(i, "F").Text) = "dnm" And Sheets("Exams-email results").Range("F2").Text = "A5" Then

bodymessage2 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B30").Text
End If


If LCase(Cells(i, "F").Text) = "dnm" And Sheets("Exams-email results").Range("F2").Text = "A6" Then

bodymessage2 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B31").Text
End If

If LCase(Cells(i, "F").Text) = "dnm" And Sheets("Exams-email results").Range("F2").Text = "A7" Then

bodymessage2 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B32").Text
End If

If LCase(Cells(i, "F").Text) = "dnm" And Sheets("Exams-email results").Range("F2").Text = "A8" Then

bodymessage2 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B33").Text
End If





"K"


If LCase(Cells(i, "F").Text) = "dnm" And Sheets("Exams-email results").Range("F3").Text = "K1" Then

bodymessage2 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B20").Text
End If

If LCase(Cells(i, "F").Text) = "dnm" And Sheets("Exams-email results").Range("F3").Text = "K2" Then

bodymessage2 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B21").Text
End If
If LCase(Cells(i, "F").Text) = "dnm" And Sheets("Exams-email results").Range("F3").Text = "K3" Then

bodymessage2 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B22").Text
End If

If LCase(Cells(i, "F").Text) = "dnm" And Sheets("Exams-email results").Range("F3").Text = "K4" Then

bodymessage2 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B23").Text
End If

If LCase(Cells(i, "F").Text) = "dnm" And Sheets("Exams-email results").Range("F3").Text = "K5" Then

bodymessage2 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B24").Text
End If

"PS"


If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("E3").Text = "PS1" Then

bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B35").Text
End If
If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("E3").Text = "PS2" Then

bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B36").Text
End If
If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("E3").Text = "PS3" Then

bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B37").Text
End If
If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("E3").Text = "PS4" Then

bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B38").Text
End If
If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("E3").Text = "PS5" Then

bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B39").Text
End If
If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("E3").Text = "PS6" Then

bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B40").Text
End If
If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("E3").Text = "PS7" Then

bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B41").Text
End If

If LCase(Cells(i, "D").Text) = "dnm" And Sheets("Exams-email results").Range("E3").Text = "PS8" Then

bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B42").Text
End If




"EXam"



If LCase(Cells(i, "G").Text) = "dnm" And Sheets("Exams-email results").Range("G3").Text = "Educ" Then

bodymessage3 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B7").Text
End If


If LCase(Cells(i, "G").Text) = "dnm" And Sheets("Exams-email results").Range("G3").Text = "A1" Then

bodymessage3 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B26").Text
End If


If LCase(Cells(i, "G").Text) = "dnm" And Sheets("Exams-email results").Range("G3").Text = "A2" Then

bodymessage3 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B27").Text
End If


If LCase(Cells(i, "G").Text) = "dnm" And Sheets("Exams-email results").Range("G3").Text = "A3" Then

bodymessage3 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B28").Text
End If


If LCase(Cells(i, "G").Text) = "dnm" And Sheets("Exams-email results").Range("G3").Text = "A4" Then

bodymessage3 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B29").Text
End If


If LCase(Cells(i, "G").Text) = "dnm" And Sheets("Exams-email results").Range("G3").Text = "A5" Then

bodymessage3 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B30").Text
End If


If LCase(Cells(i, "G").Text) = "dnm" And Sheets("Exams-email results").Range("G3").Text = "A6" Then

bodymessage3 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B31").Text
End If
If LCase(Cells(i, "G").Text) = "dnm" And Sheets("Exams-email results").Range("G3").Text = "A7" Then

bodymessage3 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B32").Text
End If

If LCase(Cells(i, "G").Text) = "dnm" And Sheets("Exams-email results").Range("G3").Text = "A8" Then

bodymessage3 = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B33").Text
End If

odpovede:

Urob to a všetko bude v poriadku.

1. Namiesto toho, aby toľko premenných, ako je uvedené nižšie

   Dim bodymessage  As String
   Dim bodymessage1 As String
   Dim bodymessage2 As String
   Dim bodymessage3 As String
   Dim bodymessage4  As String
   Dim bodymessage5 As String
   Dim Bodymessage6 As String
   

   Použite polia. Napríklad

   Dim bodymessage(1 to 7) as String
   

2. Vymažte nepotrebné prázdne riadky a odstráňte nepotrebné komentáre.

3. Napríklad týchto 6 riadkov

   fr1 = ""
   fr2 = ""
   fr3 = ""
   fr4 = ""
   fr5 = ""
   fr6 = ""
   fr7 = ""
   fr8 = ""
   fr9 = ""
   

   možno písať v 2 riadkoch

   fr1 = "": fr2 = "": fr3 = "": fr4 = "": fr5 = ""
   fr6 = "": fr7 = "": fr8 = "": fr9 = ""
   

   Toto je len príklad. V uvedenom prípade urobím presne to, čo som uviedol v bode 1. Použite pole.

   Ešte jeden bod. Nemusíte vymazať každý prvok poľa jednotlivo. Môžeš použiť Erase MyAr, Tu je príklad

   Sub Sample()
   Dim MyAr(1 To 5)
   
   For i = 1 To 5
   MyAr(i) = 1
   Next i
   
   For i = 1 To 5
   Debug.Print MyAr(i)
   Next i
   
   Erase MyAr
   
   For i = 1 To 5
   Debug.Print MyAr(i) "<~~ Nothing there
   Next i
   
   Debug.Print UBound(MyAr)
   End Sub
   

4. Opakujete If LCase(Cells(i, "D").Text) = "dnm", Použite ju iba raz a vložte do nej zvyšné príkazy if a skonvertujte ich Select Case, Napríklad

   If LCase(Cells(i, "D").Text) = "dnm" Then
   Select Case Sheets("Exams-email results").Range("D3").Text
   Case "Educ": bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B7").Text
   Case "A1": bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B26").Text
   Case "A2": bodymessage = vbNewLine & "    **    " & Sheets("SOMC-Legend").Range("B27").Text
   "
   "~~> And so on
   "
   End Select
   End If
   

Ak použijete všetko, čo som uviedol vyššie, vaša chyba zmizne :) Vždy sa snažte napísať jasný a presný kód :)