Question

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

Answer 1

这样做，一切都会好的。

而不是如下所示有这么多变量

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

使用数组。例如

Dim bodymessage(1 to 7) as String

删除不必要的空行并删除不必要的注释。

这6行例如

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

可以写成2行

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

这只是一个例子。在上面的例子中，我将完全按照我在第1点中提到的那样做。使用数组。

还有一点。您无需单独清除阵列的每个元素。您可以使用Erase MyAr。这是一个例子

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

您正在重复If LCase(Cells(i, "D").Text) = "dnm"。只使用一次并将其余的if语句放入其中并将其转换为Select Case。例如

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

如果您应用我上面提到的所有内容，那么您的错误将会消失:)总是尝试编写清晰准确的代码：）

“程序太大”错误

1 个答案: