Olá danilobtos!

Sei que já tem uns dias que vc postou, mas deixo uma sugestão.

Não sei de macros o suficiente para te ajudar, mas, há cerca de 1 semana precisei fazer quase exatamente o que você está querendo, com a diferença de que eu queria imprimir uma planilha em PDF.

Foi então que eu encontrei este anexo que te encaminho na net. O único empecilho é que está em inglês. De qualquer forma, esse tutorial (muito completo, por sinal) resolveu absolutamente 100% do meu problema; tive apenas que fazer algumas modificações do tipo: diretório onde salvar os arquivos, os e-mail que queria que recebessem a mensagem, título do e-mail, corpo do e-mail, etc.

Espero que seja útil.

Abraços!

Bruno, Muitíssimo Obrigado, com certeza será muito util.!

Olá danilobtos!

Não sei se conseguiu resolver o seu problema.

Tenho um exemplo em anexo que pode ajudá-lo.

Segue código e planilha anexada:

Sub Envia_email()



'Application.DisplayAlerts = False

Set myOlApp = CreateObject("Outlook.Application")
Set MyItem = myOlApp.CreateItem(olMailItem)
Set myAttachments = MyItem.Attachments
Set Planilha = Sheets(1) 'aqui define que o objeto é a primeira planilha na ordem,
                            'portanto, a sua que contêm os dados deve fazer o mesmo,
                            'ou alterar o código

    


On Error Resume Next


Sheets("BASE_EMAIL").Select    'coloque o nome da sua planilha que contêm os dados
Range("A4").Select

EMAIL1 = ActiveCell.Offset(0, 4).Value 'se for o caso, não se esqueça de trocar a posição da coluna na qual está o email1
EMAIL2 = ActiveCell.Offset(0, 5).Value ' o mesmo para as demais variáveis abaixo
DESTINATARIO = ActiveCell.Offset(0, 7).Value
PASTA = ActiveCell.Offset(0, 8).Value


Do While ActiveCell.Value <> "FIM"
        
        
        
        Do While ActiveCell.Value = ""  'verifica se a coluna A está desmarcada (no exemplo uso o 'X') e salta para o próximo registro
            ActiveCell.Offset(1, 0).Select
        Loop
        
        If ActiveCell.Value = "FIM" Then
            MsgBox "TODOS OS EMAILS FORAM ENVIADOS COM SUCESSO"
            Exit Sub
        End If
        
        
        EMAIL1 = ActiveCell.Offset(0, 4).Value
        EMAIL2 = ActiveCell.Offset(0, 5).Value
        DESTINATARIO = ActiveCell.Offset(0, 7).Value
        PASTA = ActiveCell.Offset(0, 8).Value
        DPS = Date

        If EMAIL1 = "" Then ' aqui você pode alterar o código e colocar condições para enviar ou para o email1, ou 2, ou os dois
        
                MsgBox "Não existe e-mail1"
                conteudo = "Não existe e-mail1"
                With MyItem
                    .to = EMAIL2
                    .Subject = "Envio de e-mail2" & DPS
                    .Body = conteudo
                    .Send ' caso queira pode colar o código abaixo para enviar o arquivo ao e-mail2
                End With
                
        Else
        
                CAMINHO = "C:TEMPEXEMPLO" & PASTA & "" & DESTINATARIO & ".xls"
                
            
                Workbooks.Open Filename:= _
                CAMINHO

                ASS = "ASSUNTO DO EMAIL" & DPS
                ActiveWorkbook.SendMail Recipients:=EMAIL1, Subject:=ASS
                ActiveWorkbook.Close
          
                conteudo = "Você recebeu um arquivo no e-mail" & EMAIL1
                With MyItem
                    .to = EMAIL2
                    .Subject = "Assunto da mensagem" & DPS
                    .Body = conteudo
                    .Send
                End With
                
                
        End If
        
        
        
        
        
    Set myOlApp = CreateObject("Outlook.Application")
    Set MyItem = myOlApp.CreateItem(olMailItem)
    Set myAttachments = MyItem.Attachments
    Set Planilha = Sheets(1)
    ActiveCell.Offset(1, 0).Select
    
Loop

End Sub

Vê se o exemplo serve e responde pra gente.

T+!!!