excel - 各ケースの Excel VBA メールを送信

Question

こんにちは、以下のコードを使用して、さまざまなケースに基づいて複数のメールを送信しています。(電子メール アドレスやその他の情報はワークシートに保存されます) コードは正常に動作しますが、20 の異なるケースがあります (以下の例では 2 つしか示していません)。各ケース内に Outlook アプリケーション コードを配置するのは面倒に思えます。

各ケース内で Outlook コードを表現することなく、各ケースに対して電子メールを実行する方法はありますか?

For Each Case を使用して検索しましたが、運がありませんでした。助けていただければ幸いです。

Sub RequestUpdates()

Dim olApp As Outlook.Application
Dim olMail As Outlook.MailItem
Dim blRunning As Boolean
Dim email As String
Dim fname As String
Dim fllink As String
Dim cpname As String
Dim v As Integer
Dim y As Integer
Dim rng As Range
Dim rdate As Date
Dim signature As String


v = Sheets("Contributors").Range("A" & Rows.Count).End(xlUp).Row
Set rng = Sheets("Contributors").Range("A1")
rdate = Sheets("Contributors").Range("A1").Value

For y = 0 To v
    Select Case rng.Offset(1 + y, 0).Value

     Case "PCR"
        email = Sheets("Contributors").Range("E4").Value
        fname = Sheets("Contributors").Range("D4").Value
        fllink = Sheets("Contributors").Range("F4").Value
        cpname = Sheets("Contributors").Range("B4").Value

            'get application
            blRunning = True
            Set olApp = GetObject(, "Outlook.Application")
            If olApp Is Nothing Then
            Set olApp = New Outlook.Application
            blRunning = False
            End If
            On Error GoTo 0

                Set olMail = olApp.CreateItem(olMailItem)
                With olMail
                .Display
                End With
                signature = olMail.HTMLBody
                With olMail
                'Specify the email subject
                .Subject = "test " & rdate
                'Specify who it should be sent to
                'Repeat this line to add further recipients
                .Recipients.Add email
                 'specify the file to attach
                 'repeat this line to add further attachments
                '.Attachments.Add "LinktoAttachment"
                 'specify the text to appear in the email
                .HTMLBody = "<p>Hi " & fname & ",</p>" & _
                "<P>Please follow the link below to update the " & cpname & " test" _
                & "For month ending " & rdate & ".</p>" & _
                "<P> </br> </p>" & _
                fllink & _
                "<P> </br> </p>" & _
                "<p>If you face issues with file access please contact me directly.</p>" & _
                "<P>Note: xxxxx.</p>" & _
                signature
                 'Choose which of the following 2 lines to have commented out
                .Display 'This will display the message for you to check and send yourself
                 '.Send ' This will send the message straight away
                End With

       Case "NFG"

            email = Sheets("Contributors").Range("E6").Value
            fname = Sheets("Contributors").Range("D6").Value
            fllink = Sheets("Contributors").Range("F6").Value
            cpname = Sheets("Contributors").Range("B6").Value

               'get application
            blRunning = True
            Set olApp = GetObject(, "Outlook.Application")
            If olApp Is Nothing Then
            Set olApp = New Outlook.Application
            blRunning = False
            End If
            On Error GoTo 0

                Set olMail = olApp.CreateItem(olMailItem)
                With olMail
                .Display
                End With
                signature = olMail.HTMLBody
                With olMail
                'Specify the email subject
                .Subject = "Test" & rdate
                'Specify who it should be sent to
                'Repeat this line to add further recipients
                .Recipients.Add email
                 'specify the file to attach
                 'repeat this line to add further attachments
                '.Attachments.Add "LinktoAttachment"
                 'specify the text to appear in the email
                .HTMLBody = "<p>Hi " & fname & ",</p>" & _
                "<P>Please follow the link below to update the " & cpname & " component Test" _
                & "For month ending " & rdate & ".</p>" & _
                "<P> </br> </p>" & _
                fllink & _
                "<P> </br> </p>" & _
                "<p>If you face issues with file access please contact me directly.</p>" & _
                "<P>Note: Test.</p>" & _
                signature
                 'Choose which of the following 2 lines to have commented out
                .Display 'This will display the message for you to check and send yourself
                 '.Send ' This will send the message straight away
                End With
            End Select
            Next
End Sub