Bom dia a todos,

Tenho uma planilha para enviar e-mails que trabalha da seguinte forma até o momento:
existe uma tabela que na coluna "b" consta o nome de cada pessoa, na coluna "c" o e-mail de cada pessoa coluna "d" o endereço dos anexos e coluna "e" e "f" com os nomes dos arquivos.

Ela funciona, mas envia somente para 1 e-mail de cada pessoa e 1 anexo para cada pessoa, meu intuito era conseguir anexar mais arquivos e na coluna dos e-mails conseguir separar por "," e colocar mais e-mails.

encaminho abaixo os códigos e link da planilha.

link:

http://rapidshare.com/files/330073718/planemails.xlsm

módulo

Sub EnviarVariosEmails()
Dim objEmail As clsEmail
Dim sh As Worksheet
Dim vNomeTemp As Variant
Dim sNomeTo As String
Dim sAnexoTo As String
Dim sEmailTo As String
Dim sStatus As String
Dim iLinhaInicial As Long
Dim iLinhaFinal As Long
Dim i As Long

On Error GoTo Erro_Sub

    Set objEmail = New clsEmail                 'Inicializa a classe clsEmail
    Set sh = Sheets("PlanListaDeEmails")        'Define a planilha

    With objEmail
        .setConfEmailServidor = "smtp.gmail.com"       'Servidor de saída de emails. Ex: smtp.uol.com.br
        .setConfEmailPorta = "465"                               'Porta. Padrão é a porta 25
        .setConfEmailSSL = True                                'Se necessita conexão segura SSL
        .setConfEmailFrom = "roneikotz@gmail.com"      'Seu email: O remetente do email. Ex: seunome@uol.com.br
        .setConfEmailSenha = "xxxxxxxxx"                        'Sua senha: A senha que você usa para acessar seus emails
        .setConfEmailFromNome = "Ronei Kotz"                      'Seu nome: O nome que será exibido no campo De:
        .Configurar     'Executa a configuração

        'Percorre a listagem de emails para enviar
        iLinhaInicial = 8                                                       'Informe a linha que começa a lista de emails
        iLinhaFinal = sh.Range("A1").SpecialCells(xlCellTypeLastCell).Row       'Recupera automaticamente a última linha da tabela

        For i = iLinhaInicial To iLinhaFinal
            Application.StatusBar = "Enviando email " & (i - iLinhaInicial + 1)

            sNomeTo = Trim(sh.Range("B" & i))
            sEmailTo = Trim(sh.Range("C" & i))
            sAnexoTo = Trim(sh.Range("D" & i)) & Trim(sh.Range("E" & i)) & ".pdf"
            
            If Len(sEmailTo) = 0 Then   'Verifica se o email do destinatário foi informado
                sStatus = "Informe o email do destinatário."
            Else
                If Len(sNomeTo) = 0 Then    'Verifica se um nome foi informado
                    vNomeTemp = Split(sEmailTo, "@")
                    sNomeTo = vNomeTemp(0)
                End If

                .setEmailTo = sEmailTo                           'Email do Destinatário
                .setEmailToNome = sNomeTo                        'Nome do Destinatário

                .setEmailTitulo = "teste"     'Título da mensagem

                'Aqui, você deve digitar o conteúdo. Pode utilizar formatação HTML.
                .setEmailConteudo = "" & .getEmailToNome & ".Segue em anexo "
                                                  
                .setEmailAnexo = sAnexoTo
                .EnviarEmail

                sStatus = "Email enviado com sucesso!"
                .setEmailAnexo = "sAnexoTo"
                                
            End If

            sh.Range("g" & i) = sStatus     'Escreve o status do envio
        Next i

    End With

    Set objEmail = Nothing
    Set sh = Nothing

    Application.StatusBar = False
    MsgBox "Emails enviados", vbInformation

Exit Sub
Erro_Sub:
MsgBox Err.Description, vbExclamation
Exit Sub
End Sub

módulo de classe clsEmail

Option Explicit

Private iConf                   As Object
Private iMsg                    As Object
Private confEmailFromNome       As String
Private confEmailFrom           As String
Private confEmailSenha          As String
Private confEmailServidor       As String
Private confEmailPorta          As String
Private confEmailSSL            As Boolean
Private emailTo                 As String
Private emailToNome             As String
Private emailTitulo             As String
Private emailConteudo           As String
Private emailAnexo              As Variant

Public Property Let setConfEmailFromNome(value As String)
    confEmailFromNome = Trim(value)
End Property
Public Property Let setConfEmailFrom(value As String)
    confEmailFrom = Trim(value)
End Property
Public Property Let setConfEmailSenha(value As String)
    confEmailSenha = Trim(value)
End Property
Public Property Let setConfEmailServidor(value As String)
    confEmailServidor = Trim(value)
End Property
Public Property Let setConfEmailPorta(value As String)
    value = Trim(value)
    If Len(value) = 0 Then value = "25"
    confEmailPorta = value
End Property
Public Property Let setConfEmailSSL(value As Boolean)
    confEmailSSL = value
End Property
Public Property Let setEmailTitulo(value As String)
    emailTitulo = Trim(value)
End Property
Public Property Let setEmailConteudo(value As String)
    emailConteudo = Trim(value)
End Property
Public Property Let setEmailAnexo(value As Variant)
    emailAnexo = value
End Property
Public Property Let setEmailTo(value As String)
    emailTo = Trim(value)
End Property
Public Property Let setEmailToNome(value As String)
    emailToNome = Trim(value)
End Property

Public Property Get getEmailTo() As String
    getEmailTo = emailTo
End Property
Public Property Get getEmailToNome() As String
    getEmailToNome = emailToNome
End Property

Public Function Configurar() As Boolean
Dim Flds As Variant
On Error GoTo Err_Class

    Set iMsg = CreateObject("CDO.Message")
    Set iConf = CreateObject("CDO.Configuration")

    iConf.Load -1
    Set Flds = iConf.Fields
    With Flds
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = confEmailServidor
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = confEmailPorta
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = confEmailFrom
        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = confEmailSenha
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = confEmailSSL

        .Update
    End With

    With iMsg
        Set .Configuration = iConf
    End With

    Configurar = True

Err_Exit:
    Exit Function
Err_Class:
    Configurar = False
    MsgBox "Ocorreu um erro. [" & Err.Number & "]", vbExclamation
    GoTo Err_Exit
End Function

Public Function EnviarEmail() As Boolean
Dim strbody As String
Dim i As Integer

On Error GoTo Erro

    'adiciona quebras de linha
    strbody = Replace(emailConteudo, "<br>", "<br>" & vbCrLf)

    With iMsg
        .To = emailToNome & " <" & emailTo & ">"
        .CC = ""
        .BCC = ""
        .FROM = confEmailFromNome & " <" & confEmailFrom & ">"
        .Subject = emailTitulo
        .HTMLBody = emailConteudo

        'Anexa arquivos ao email
        .attachments.DeleteAll
        If IsArray(emailAnexo) Then     'Se mais de um arquivo para anexar
            For i = 1 To UBound(emailAnexo)
                .AddAttachment emailAnexo(i)    'anexa um por um dos arquivos
            Next i
        Else        'Se apenas um arquivo para anexar
            If Len(emailAnexo) > 0 Then
                .AddAttachment emailAnexo
            End If
        End If

        .Send       'Comando para enviar o email
    End With

    EnviarEmail = True

Exit Function
Erro:
    EnviarEmail = False
    MsgBox "Falha no envio do Email." & vbCrLf & Err.Description, vbExclamation
    Exit Function
End Function

Private Sub Class_Terminate()
On Error GoTo Err_Class

    Set iMsg = Nothing
    Set iConf = Nothing

Err_Exit:
    Exit Sub
Err_Class:
    MsgBox "Ocorreu um erro. [" & Err.Number & "]", vbExclamation
    GoTo Err_Exit
End Sub

espero que alguém consiga me ajudar.
desde já agradeço.