Макрос рассылки по разным адресатам

Sub SendMail()
    Dim objEmail
    Const cdoSendUsingPort = 2 ' Send the message using SMTP
    Const cdoBasicAuth = 1 ' Clear-text authentication
    Const cdoTimeout = 60 ' Timeout for SMTP in seconds
    Dim a(1, 5) As String
    a(0, 0) = "mprusov@mail.ru": a(1, 0) = "Z:\Maksim\Macro.xlsx"
    a(0, 1) = "kevlevmax@yandex.ru": a(1, 1) = "Z:\Maksim\Macro1.xlsx"
    a(0, 2) = "gdigdalo@mail.ru": a(1, 2) = "Z:\Maksim\Macro2.xlsx"
    a(0, 3) = "mprusov@mail.ru;kevlevmax@yandex.ru": a(1, 3) = "Z:\Maksim\Macro3.xlsx"
    a(0, 4) = "mprusov@mail.ru;kevlevmax@yandex.ru;gdigdalo@mail.ru": a(1, 4) = "Z:\Maksim\Macro4.xlsx"
    a(0, 5) = "mprusov@mail.ru;gdigdalo@mail.ru": a(1, 5) = "Z:\Maksim\Macro1.xlsx"
    
    For i = 0 To 5
        mailServer = "smtp.gmail.com"
        SMTPport = 465
        mailusername = "maximprusov2000@gmail.com"
        mailpassword = "*********" 'your password
        mailto = a(0, i) '"mprusov@mail.ru;kevlevmax@yandex.r u;gdigdalo@mail.ru"
        mailSubject = "Subject line"
        mailBody = "This is the email body"
        Set objEmail = CreateObject("CDO.Message")
        Set objConf = objEmail.Configuration
        Set objFlds = objConf.Fields
        With objFlds
            .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = cdoSendUsingPort
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = mailServer
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = SMTPport
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = cdoTimeout
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoBasicAuth
            .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = mailusername
            .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = mailpassword
            .Update
        End With
        objEmail.To = mailto
        objEmail.From = mailusername
        objEmail.Subject = mailSubject
        objEmail.TextBody = mailBody
        objEmail.AddAttachment a(1, i) '"Z:\Maksim\Macro.xlsx"
        objEmail.Send
    Next
    Set objFlds = Nothing
    Set objConf = Nothing
    Set objEmail = Nothing
    
End Sub