Change VBA code to email each sheet to email in list

[duranimal86]

I have the current code below that works to email each tab from a master workbook to the email address in cell A2 of each tab as long as there isn't an X in B1 (used to exclude/select certain tabs). But instead of having the email and exclusion on each tab I want to have a list of the sheets and email addresses on the Info tab and have the rest of the procedures reference there instead. How can i modify the code to get that to work?

Info sheet:
Col A: Blank or X to make the code skip that sheet
Col B: List of sheet names
Col C: Email addresses to send sheet to

Sub Mail_Every_Worksheet()    
    Dim sh As Worksheet
    Dim wb As Workbook
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim FilePath As String
    Dim FileName As String
    Dim OutApp As Object
    Dim OutMail As Object
    Dim signature As String
    Dim NameVariable As String
    
     
    FilePath = Range("I2").Value
    
    NameVariable = "P" & Range("F2").Value & "-" & Range("F3").Value & " GL Detail - NAF "




    If Right(FilePath, 1) <> "\" Then
        FilePath = FilePath & "\"
    End If
    
    If Dir(FilePath, vbDirectory) = vbNullString Then
        MsgBox "Folder doesn't exist. Must create folder to save to first", vbInformation, "Folder Check"
        Exit Sub
    
    End If
    


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


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


    Set OutApp = CreateObject("Outlook.Application")
    


    For Each sh In ThisWorkbook.Worksheets
        If sh.Range("A2").Value Like "?*@?*.?*" And sh.Range("B1").Value <> "X" Then


            sh.Copy
            Set wb = ActiveWorkbook
            
            FileName = sh.Name & " " & Format(Now, "mm.dd.yy")


            With wb
                .SaveAs FilePath & NameVariable & FileName & FileExtStr, FileFormat:=FileFormatNum


            Set OutMail = OutApp.CreateItem(0)


                On Error Resume Next
                With OutMail
                .Display
                    .to = sh.Range("A2").Value
                    .CC = ""
                    .BCC = ""
                    .Subject = "This is the TEST Subject line"
                    '.Body = "Hi there"
                    .HTMLbody = "****** style=font-size:11pt;font-family:Calibri>ENTER TEXT TO INCLUDE IN EMAIL HERE" & "" & .HTMLbody
                    .Attachments.Add wb.FullName
                    'You can add other files also like this
                    '.Attachments.Add ("C:\test.txt")
                    .Display
                    '.Send   'or use .Display
                End With
                On Error GoTo 0


                .Close savechanges:=False
            End With
            
            Set OutMail = Nothing


            'Kill TempFilePath & TempFileName & FileExtStr
            'above was for temp file to be emailed then deleted, but not used now that saving files


        End If
    Next sh


    Set OutApp = Nothing


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

Also, suggestions are welcome for a better way to select/exclude sheets when only certain ones are needed.