need help fixing my code for sending automatic emails through vba

Question

I have recently written a code that allows me to send an email to a specific person in a range when clicking the command button. My code originally was working fine, however, I wanted to reference my range of these peoples emails on another sheet named "Parameter" instead of the active sheet.

When I changed my code it worked but instead of sending one email it sent three. I need help ending my code so that it will only send one email.

Private Sub JLechner_Click()
Dim sh As Worksheet
Dim sh2 As Worksheet
    Dim wb As Workbook
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String



    TempFilePath = Environ$("temp") & "\"

    If Val(Application.Version) < 12 Then
        'You use Excel 97-2003
        FileExtStr = ".xls": FileFormatNum = -4143
    Else
        'You use Excel 2007-2016
        FileExtStr = ".xlsm": FileFormatNum = 52
    End If

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    Set OutApp = CreateObject("Outlook.Application")
     Set sh2 = ThisWorkbook.Sheets("Parameter")

    For Each sh In ThisWorkbook.Worksheets
        If sh2.Range("K8").Value Like "?*@?*.?*" Then

            sh.Copy
            Set wb = ActiveWorkbook

            TempFileName = "Sheet " & sh.Name & " of " _
                         & ThisWorkbook.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")

            Set OutMail = OutApp.CreateItem(0)

            With wb
                .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum

                strbody = "(See below for english version)" & vbNewLine & vbNewLine & _
              "Hallo," & vbNewLine & vbNewLine & _
              "Maß " & sh.Range("E4").Value & " muss geprüft werden." & vbNewLine & _
              "Bitte im Sharepoint die prüfung durchführen." & vbNewLine & vbNewLine & _
              "Die Maßnahmenblätter finden Sie unter folgendem Link:" & vbNewLine & vbNewLine & _

              "Wenn die Prüfung abgeschlossen ist, bitte die Taste auf der rechten Seite der tabelle drücken, um die Maßnahme zum folgendem Bearbeiter weiterzuleiten." & vbNewLine & _
              "Wenn Sie Unterstützung brauchen, bitte kontaktieren Sie Bob and Ryan." & vbNewLine & vbNewLine & _
              "Vielen Dank." & vbNewLine & _
              "Mit freundlichen Grüßen" & vbNewLine & _
              "Team" & vbNewLine & vbNewLine & vbNewLine & _
              "----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------" & vbNewLine & vbNewLine & vbNewLine & _
              "Hello," & vbNewLine & vbNewLine & _
              "Measure " & sh.Range("E4").Value & " must be checked." & vbNewLine & _
              "Please access the Sharepoint and proceed with your corresponding check." & vbNewLine & vbNewLine & _
              "Measures can be found using the following link:" & vbNewLine & vbNewLine & _

              "When finished, please forward the measure to the next responsible person using the buttons on the right side of the table." & vbNewLine & _
              "If you require support, contact any MTM responsible persons." & vbNewLine & vbNewLine & _
              "Thank you," & vbNewLine & _
              "Best regards," & vbNewLine & _
              "Team"


                On Error Resume Next
                With OutMail
                    .To = sh2.Range("K8").Value
                    .CC = ""
                    .BCC = ""
                    .Subject = "Bitte Maßnahmenblatt bearbeiten: " & sh.Range("E4").Value
                    .Body = strbody


                    .Send   'or use .Display
                End With
                On Error GoTo 0

                .Close savechanges:=False
            End With

            Set OutMail = Nothing

            Kill TempFilePath & TempFileName & FileExtStr

        End If
    Next sh

    Set OutApp = Nothing

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

Please let me know if anyone can help me with this.

Answer 1

I think you need to just change this

For Each sh In ThisWorkbook.Worksheets
    If sh2.Range("K8").Value Like "?*@?*.?*" Then

to this

For Each sh In ThisWorkbook.Worksheets
    If sh.Range("K8").Value Like "?*@?*.?*" Then

Because you are looping over every sheet but checking condition for sheet Parameter everytime which results TRUE for every worksheet.